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ABSTRACT 

COMPUTE is a computer program, written primarily in FORTRAN IV and operating 
under the IBM 360/67 Time- Sharing System. COMPUTE allows users to perform vari- 
ous numerical calculations solely by interacting with COMPUTE. This report gives de- 
tails on the computer system, and outlines the structure of the computer program. This 
report is intended to serve as a guide for adapting and implementing COMPUTE. Com- 
plete source listings are included. 
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IMPLEMENTATION AND STRUCTURE OF COMPUTE, A 
TIME-SHARING CALCULATOR PROGRAM 
by R. Bruce Canright, Jr., and Paul Swlgert 
Lewis Research Center 

SUMMARY 

COMPUTE is a computer program, written primarily in FORTRAN IV and operating 
under the IBM 360/67 Time-Sharing System. This report gives details on the computer 
system and outlines the structure of the computer program. It is intended to serve as a 
guide for adapting and implementing COMPUTE. Access to the system, program crea- 
tion and execution, the logical structure of COMPUTE, and the functions of the sub- 
routines and COMMON blocks are discussed. Complete source listings are included. 

INTRODUCTION 

A calculator program, COMPUTE, has been developed and is running under a time- 
sharing computer system, the IBM 360/67 Time -Sharing System (TSS). The capabilities 
and use of this program have been described previously (ref. 1) . This report describes 
the computer system and COMPUTE in enough detail to guide implementation on other 
computers. This system encompasses a powerful command language and a virtual storage 
concept. Details on creating and executing COMPUTE under TSS are given in the first 
section. 

The program consists of 40 routines, 37 in FORTRAN. The structure of these rou- 
tines is outlined in the second section so that COMPUTE may easily be modified. 


COMPUTER SYSTEM 

COMPUTE was developed on the IBM 360 Model 67 under the Time-Sharing System 
(TSS). The purpose of this section is to describe TSS only as it affects the structure and 
execution of COMPUTE. This description will also show the areas to consider when 



implementing COMPUTE under other computer systems. The TSS concepts mentioned 
herein are explained in more detail in references 2 to 4. 


Access to TSS 

Computer users gain access to TSS through card readers for batch tasks and through 
on-line devices for interactive, conversational tasks. COMPUTE is meant to be run 
conversationally. Access to the program is by on-line devices such as typewriter, tele- 
type, and cathode ray tube (CRT) display terminals. Users are recognized by the system 
through unique names or codes. This process is called LOGON. 


Computer Program Creation 

Users who are LOGged ON become interactive with TSS and have available to them 
all data sets (ref. 2) either created by them or shared with them by other users. These 
data sets can include, among other things, source programs and special data sets called 
job libraries. Job libraries contain the object programs produced by language proces- 
sors, for example, by a FORTRAN compiler. To create an object program, that is, one 
suitable for loading and execution, a user (1) defines a job library to contain the output 
object program, (2) creates the input source program, and (3) feeds it to the appropriate 
language processor, which stores the object program in the job library. 


Computer Program Execution 

To execute a program, an active user (1) defines the job library (or libraries) con- 
taining the program and all other programs it calls (via the DATA DEFINITION Com- 
mand), (2) loads the program into his active storage (via the LOAD Command), and 
(3) runs the program (via the RUN Command). As we will see, COMPUTE programs are 
contained in the system library (SYSLIB) and in a private library called COMPTLIB. 

When programs require input/output streams, the user may define them or default 
and let the system define them. For running COMPUTE and for other conversational 
tasks, these default input/output streams are from or to the on-line user’s terminal. 

With one exception, COMPUTE is meant to interact with user solely via this terminal. 
The exception is in input/output of the data set KEYWORDS, to be discussed later. 
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TSS Computer Words 


The computer words under TSS and expected by COMPUTE are short precision words 
(32 bits). This length permits four characters or approximately six significant figures 
for floating point numbers. The full EBCDIC character set (appendix H of ref. 4) is as- 
sumed by COMPUTE. 


Machine- Dependent Routines Used in COMPUTE 

Although written mainly in FORTRAN IV (ref. 5), COMPUTE uses extensively two 
shift routines contained in the IBM/360 shift package. ISRL (N, IWORD) shifts the full 
integer word, IWORD, N bits to the right. ISLL (N, IWORD) shifts the full integer word, 
IWORD, N bits to the left. These shifts are used extensively for character manipulation, 
COMPUTE reads all input in A1 format (ref. 5) and then translates into A4 format, short 
precision numbers, etc. COMPUTE only requires shifts of 8 bits to the left and 24 bits 
to the right; therefore, on the IBM 360/67 the FORTRAN coding can be substituted for 
the assembler language shift routines. The IBM/360 TSS shift functions are listed in 
the appendix. 

FORTRAN Shifts for COMPUTE are as follows: 

C SPECIAL FORTRAN SHIFTS FOR COMPUTE 

FUNCTION ISLL (NN, IWRD) 

INTEGER MASK/Z80 00 00 00/ 

IWORD = IWRD 
DO 1 1=1, NN 

1 IWORD= IWORD *2 
GO TO 3 

ENTRY ISRL (NN, IWRD) 

INTEGER MASKR/Z00 00 00 80/ 

IWORD=IWRD 

C SET SIGN BIT TO ZERO 

IF (IWORD. LT. 0) IWORD+MASK 
DO 2 1=1, NN 

2 IWORD=IWORD/2 

C RESTORE BIT IF NEEDED 

IF (IWRD. LT. 0) IWORD=IWORD+MASKR 

3 ISLL= IWORD 
RETURN 
END 
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COMPUTE uses a special routine developed at Lewis for loading user object pro- 
grams dynamically while COMPUTE is executing. By dynamic loading, we mean herein 
that user input to COMPUTE can cause user object programs to be loaded into the user’s 
active storage or executed after loading. To do this the user inputs a program entry 
name, or a keyword previously stored in COMPUTE, which corresponds to a program 
entry name (see section Discussion of KEYWORDS). It is expected that this feature will 
be difficult to implement under systems other than TSS. 

COMPUTE uses three ENTRY points in this routine. LOADED{NAME, KODE) re- 
turns KODE=l if entry NAME is already loaded into the user’s active storage, KODE=2 
if not. LOAD (NAME, KODE) returns KODE=l if it is able to load NAME, KODE=2 if not. 
RUNIT(NAME, NARG, ARG, ANS, KODE) executes user routine NAME, which has NARG 
arguments in array ARG, and returns one numerical result (if any) in ANS, KODE=l 
if everything is successful, and KODE=2 if there are any error conditions. This routine 
is listed for completeness in the appendix. To run COMPUTE without the loading fea- 
ture, dummy ENTRY points must be provided. 

One routine in COMPUTE, SUBROUTINE EX PON, tests a system switch, 

OVERFL(J) where J=1 indicates overflow, J-3 indicates underflow, and J=2 means 
neither condition encountered. TSS will not indicate either condition without this test. 
However, error returns from FORTRAN - supplied routines, for example, SDST(X) are 
indicated (and, in fact, presently stop execution of COMPUTE). An ENTRY OVERFL(J) 
is required if such a switch is not available in a system. 

Finally, the main routine for COMPUTE itself can be written in assembler language 
(ref. 6). This has the advantage that the main program can define (via ENTRY LIBDEF, 
see listings) and close (via ENTRY LfBREL) the two data sets required to run COMPUTE, 
KEYWORDS, and COMPTLIB. KEYWORDS is a set of tables, and COMPTLIB is the job 
library containing the COMPUTE routines; these are owned by one user and may be 
obtained by other users via the SHARE command. The listing of this routine is given in 
the appendix. This routine is in the system library and available to all users. 

When the main program is in FORTRAN, the user must use DATA DEFINITION 
commands to describe KEYWORDS and COMPTLIB to the system. These commands 
simply define KEYWORDS to be a FORTRAN input /output unit, and COMPTLIB to be a 
library of object programs. 


STRUCTURE OF COMPUTE 

COMPUTE can be thought of as a set of FORTRAN routines, an interpretive user 
language, or both. The language has been described previously (ref. 1). The purpose 
of this section is to describe the working of the FORTRAN routines briefly (flow charts 
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of each deck will not be given) but in enough detail to show the way for changes or addi- 
tions. 


Coded Strings 

Users can define functions and procedures within COMPUTE (see ref. 1). These are 
stored in arrays, in coded strings. These strings are the heart of COMPUTE processing. 
The method of storing functions and procedures will now be sketched. 

The string for a user function begins with two locations for the function name (there- 
fore, < eight characters), then a pointer to the next string, then a counter of the argu- 
ments, then the argument names (two locations per name), and finally the arithmetic ex- 
pression of the function (after interpretation). This structure is presented in table I. 
These strings are contained in the array IUSFCT (1000). 


TABLE I. - STRING FOR USER FUNCTION [f(x) = x*x] 


Location 

Contains 

Symbolic name 

Example 

i 

Function name (1) 


bbbb 

i-f-1 

Function name (2) 


bbbF 

i+2 

Pointer to beginning of 

N POINT 

— 


next name 



i+3 

Number of arguments for 

NARGS 

1 


this function 



i+4 

Argument name (1) 


i bbbb 

in- 5 

Argument name (2) 


bbbx 


Argument name (1) 



i+3+2*NARGS 

Argument name (2) 



1+4+2+NARGS 

Arithmetic expression for 

------- 

X 


function; 


+ 


Coded, may include other 




functions, constants, 


X 


arguments, etc. 



N POINT 

Next function name (1) 

| - - 



Next function name (2) 





The string for a user procedure begins with two locations for the procedure name, 
then a pointer to the next name, then a counter of the lines in this procedure, and then 
substrings for each line. These substrings contain a length pointer, a code to indicate 
their type, and the packed expression of the line itself. The types of substrings include: 
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(1) name = ? 

TYPE = 2 

(2) name = expression 

TYPE = 1 

(3) expression = ? 

TYPE = 3 

(4) COMPUTE commands except PRINT 

TYPE = 5 

(5) PRINT 

TYPE = 4 

(6) END statement 

(no TYPE) 


This structure is shown in table II for a three-line procedure, 
tained in the array IUSPCD (2000). 


These strings are con- 


TABLE n. - STRING FOR USER PROCEDURE 


Location 

Contains 

Symbolic name 

Example 

i 

i+1 

Procedure name (1) 
Procedure name (2) 



i+2 

Pointer to beginning of 
next name 

NFOINT 


i+3 

Number of lines for this 
proc edure 

N LINES 

3 

i+4 

Length of first line 

NLENl 

6 

i+5 

Code for first line 

TYPE 

1 

i+6 

Arithmetic expression for 
this line, depending on 
code 


x-x+1 

i+6+NLENl 

Length of this line 

NLEN2 

2 

1+7+NLEN1 

Code for this line 

TYPE 

4 

i+8+NLENl 

Arithmetic expression for 
this line 


PRINT{X) 

i+8+NLENl+ 

NLEN2 

Length of expression on 
left hand side of < or > 


1 

N POINT 

Arithmetic expression for 
this last line (END 
statement) 

Procedure name (1) 
Procedure name (2) 


X < 14 
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Functions of the Subroutines 


There are 40 subroutines within COMPUTE. We will not attempt to analyze the logic 
of each; it is hoped the listings in the appendix will serve that purpose, where necessary. 
Instead, we will explain briefly what each subroutine does, and then which routines call 
which. The routines are described in alphabetic order for each in reference. Entry 
points are listed with the subroutines they are contained in. 


BEGNIT 

CNVRT 

COMMND 

COMPUTE 

CPUTIT 

CREATE 

DOIT 
DUMPIT 
ENDIT 
ERASIT 
EVAL, EVALI 

EXEQQS 

EXPON,ADD, DVD, 
SUB, MULT 

EXPR 


begins new procedures, stores new name 

converts input numbers in A1 format to floating point num- 
bers for use in arithmetic 


analyzes input for valid COMPUTE commands. If one is 
found, calls appropriate routine, for example, DOIT 

main program; defines data sets if in assembler language, 
otherwise dummy 

control program; decides what to call after first scan of in- 
put (by READIT) 

small main program for initializing KEYWORDS; required 
only once, listed for completeness 

processes commands to do user procedures 

dumps out requested operands, for example, values 

in creating procedures, processes end statement 

erases requested operands, frees storage they used 

processes string of expressions produced by PRESS 1, 

PRESS2, by calling EXPR for each expression 

processes form expression = ?, either as command or line of 
procedure 


performs arithmetic for one operator 


processes one expression by finding operators and calling 
arithmetic routine 
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FNDNAM 


searches lists and classifies user's names 


FNEQEX 

FOFX 

INITAL 

INTGRL 

INTIT 

ISRL, ISLL 

LISTIT 

LOAD, LOADED, RUNIT 

MODEIT 

MSG 

NMBR 


defines user function 

evaluates user function for integration routine, SIMPS 1 
initializes all arrays, does bookkeeping on KEYWORDS 
processes INTEGRATE command 

processes INT function, integration function in COMPUTE 

shift routines in assembler language (discussed in first sec- 
tion) 

dummy routine presently intended to serve similarly to 
DUMPIT, not developed 

execution time loading routine in assembler language (dis- 
cussed in first section) 

checks and sets mode following MODE command 
issues all output messages 

processes expressions assumed to be numbers, calls 
CNVRT 


NMEQEX 

NMEQNU 

NMEQQS 

OVERFL 

PGMEVL 

PGMFCT 

PGMNAM, PGMLST 


processes form, name-expression, either as command or 
line of procedure 

stores user values and value names 

processes form, name=? , either as command or line of 
procedure 

system switch for overflow and underflow conditions (dis- 
cussed in first section) 

loads user programs and prepares arguments 

calls system functions whenever references to them appear 

outputs information on system functions 


8 



PRESS! , PRESS2 


packs and factors user input strings into chains of expres- 
sions 


PRNTIT,PENT 

READIT, READT1 

RESLV1 , RESLV2 
SIMPS 1 

USRFCT 


responds to PRINT commands. PRNT produces no output, 
is called following PRINT commands in procedures 

reads lines of user input, performs first scan on punctua- 
tion, operators, etc. 

resolves names referenced by user 

performs numerical integration of functions. A powerful 
routine developed at Lewis 

performs evaluation of user functions 


USRPGM 


causes execution of user object program 


Flow of control among these routines is illustrated in figure 1. Roman numerals in pro- 
gram blocks indicate that the flow is continued elsewhere in the figure. 



Classify 

statement 


NMEQQS ^ ~**" 
~* ^ NMEQEX } ‘ 

FNEQEX y ~* 
EXEQQS 


(a) Main flow of control* 

Figure X - Flow map of COMPUTE program. 


I 
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(b) Processing five types of COMPUTE statements. 
Figure L - Continued 






















ic) Continue! 
Figure 1, - Continued, 
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Ic) Continued 
Figure 1 . - Continued, 






{ci Concluded 
Figure L - Concluded 


Functions of COMMON Blocks 

There are six blocks of COMMON storage used in COMPUTE. The Common blocks 
are further described as follows and in table HI. 

COMMON/NAMES/ contains user values and value names 
COMMON/FCTS/ contains all user functions 

COMMON/PROCDS/ contains all user procedures 

COMMON/MODE 1/ contains information on the current mode 
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COMMON/AC MDS/ 


contains table, created by use of KEYWORDS, which allows user 
programs to be called by key names, other than program or 
entry names 

COMMON/NANCY/ communicates information to routines which do integration 


TABLE in. - COMMON BLOCK STRUCTURE 


COMMON 

block 

Appears in 

Variable 

Contents of variable 

/NAMES/ 

INITAL, DUMPIT, PRNTIT, 

NMLT 

Number of user defined value names 


ERASIT, NMEQQS, NMEQNU, 

NAME{100) 

All user defined value names 


PRESS1, RESLV1, FNDNAM ' 

VALUE (50) 

The corresponding values 

/FCTS/ 

INITAL, DUMPIT, ERA SIT, 

NFCT 

Number of user defined functions 


NMEQQS, FNEQEX, USRFCT, 

LSTI 

Pointer to end of IUSFCT list 


FNDNAM, IN TIT, INTGRL, 
FOFX 

IUSFCT(IOOO) 

List of all user defined function names 
and coded strings 

/PROCDS/ 

INITAL, READIT, PGMEVL, 

NFCD 

Number of user procedures 


DUMPIT, PRNTIT, ERA SIT, 

LASTI 

Pointer to end of IUSPCD list 


BEGNIT, ENDIT, DOIT, 
NMEQQS, EXEQQS, 

ICNT 

Pointer to line of current procedure; 
number of lines 


NMEQEX, FNDNAM 

IUSPCD(2000) 

List of all user procedure names and 
their coded strings 

/MODE1/ 

INITAL, COMPUTE, CPUTIT, 
READIT, PGMEVL, DUMPIT 

DEBUG 

LOGICAL, T means in DEBUG mode, 
F means no DEBUG 


PRNTIT, 

ERA SIT, MODEIT, BEGNIT, 
ENDIT, DOIT, NMEQQS, 
NMEQNU, EXEQQS, 
NMEQEX, FNEQEX 
FNDNAM, INTGRL 

PROCED 

LOGICAL, T means procedure being 
built, F means not 

i 

/AC MDS/ 

INITAL, COMMND 

NAXCMD 

AUXCMD (3, 33) 
PGM(2, 33) 

Number of current keyword calls to 
user programs possible, <33 
List of keywords current 
List of corresponding program or 
entry names current 

/NANCY/ 

INTGRL, INTIT, FOFX 

IND 

NARG 

NA 

NB 

Pointer to name of function in question 
! Number of arguments for function in 
question 

Pointer to beginning of functions 
coded string 

Pointer to end of functions coded 
string 
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Explanation of KEYWORDS 


A special data set, KEYWORDS, is maintained within COMPUTE by SUBROUTINE 
INITAL solely to extend the dynamic loading feature discussed in the section COMPUTER 
SYSTEM. KEYWORDS contain tables which map user -chosen names (of up to 12 charac- 
ters) onto ENTRY point names (up to 6 characters). These tables allow users to load 
and execute programs with the dynamic loading routine by names other than ENTRY 
names. 

An application of this is as follows: A user owns some routines of general applica- 
tion, which he shares with other users. He wants to make them accessible by mnemonic 
names, and yet be able to modify ENTRY points. He could do this by building a table 
and a keyword pointing to it in KEYWORDS. It should be emphasized that KEYWORDS 
has nothing to do with program loading and execution and that it simply allows greater 
freedom in naming. 

For example, the COMPUTE main program (see listing) defines a job library 
(MAT LIB) containing a set of conversational matrix routines (ref. 7). Suppose these 
routines are accessed by the ENTRY name MATAR. The owner of MATLIB could place 
in KEYWORDS the keyword MATRIX, which could invoke the table: 


Keyword 

MATRIX 

INVERSE 

DETERMINANT 

EIGENVALUES 


Entry executed 

MATAR 

MATAR 

MATAR 

MATAR 


Then the matrix program could be executed in COMPUTE as in the following session. 


User 

COMPUTE: 
User : 

COMPUTE: 
COMPUTE: 
User : 

COMPUTE: 


starts execution of COMPUTE 
ENTER USE KEYWORD 
MATRIX 
(load MATAR) 

READY 

EIGENVALUES 

Starts execution of MATAR 


Of course, user programs can be obtained by COMPUTE by their ENTRY names also, as 
previously discussed. 

To build and maintain tables in KEYWORDS, a user enters the SYSKEY 
(b. LAMPOON, bb in listing of INITAL) when COMPUTE outputs ENTER USE KEYWORD. 
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It is intended that the SYSKEY be known by few users. The logic of INITAL is shown in 
figure 2. 


CONCLUDING REMARKS 

A time- sharing calculator program, COMPUTE, has been developed under a particu- 
lar computer system (IBM 360-67 Time-Sharing System). Many users at Lewis (not com- 
puter professionals) have successfully applied COMPUTE in their work. Because this 
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program can have widespread applications, details about the system and the pregram, 
written primarily in FORTRAN IV, were presented herein. These details should guide 
the implementation of COMPUTE at other computer installations and with other computer 
systems. 

Lewis Research Center, 

National Aeronautics and Space Administration, 

Cleveland, Ohio, April 23, 1969, 

129-04-06-03-22. 
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APPENDIX - SOURCE LISTINGS FOR COMPUTE 


Complete listings of the COMPUTE routines are included herein. Those interested 
in obtaining source decks should contact COSMIC, The University of Georgia, Athens, 
Georgia. 


computer 


SAVE 

$A VE2 

SWITCH 

ACCQMPT 

KEYS 

MODE I 

DEBUG 

pRecet 

CO'PUTiC 

COMPUTE 


MAIN PROGRAM 
PSECT 


FOR COMPUTE 


CALL l T 


L IEDEF 


* 

* 


ENTRY 

ENTRY 

ENTRY 

DC 

DC 

OC 

DC 

DC 

DC 

CCS 

CCM 

OC 

CC 

CSECT 

USING 

SAVE 

L 

ST 

ST 

1R 

USING 

LR 

DROP 

USING 

CALL 

L 

C 

8NE 

L 

ST 

DDEF 

CCEF 

CALL 

CALL 

L 

RETURN 

USING 

SAVE 

L 

USING 

LA 

ST 

ST 

LR 

L 

DROP 

USING 

DDEF 

l 

RETURN 


COMPUTE, LIBDEF, LIBREL 

COMPUTE ENTRY NAME 

LIBOEF 

LIBREL 

F • 76 f SAVE AREA 

18F*0* 

F * 76 1 
18F * 0 * 

F * 0 * FIRST TIME SWITCH 

Af COMPUTE J 

DONAME^FTO5F0Ol,RECFM=F, LRECL=84 


F»0* 

F 1 Q 1 

READONLY , PU9L I C 

COMPUTERS 

(14,12) 

14,7210,13) 

14,8(0,133 

13,4(0,14) 

13, 14 

COMPUTER, 13 

12,15 

15 

COMPUTE, 12 
CHCB01 
7, SWITCH 
7,=F*0» 

CAILIT 
7 , ”F * 1 1 
7, SWITCH 


START OF CSECT 


GET PSECT COVER REG 


STORE BACKWARD LINK 

SET REG 13 TO ADDRESS OF PSECT 


SET INTERRUPTS LIKE FORTRAN 
FIRST 
TIMET 
MO 
YES 

$ W I TCH= 1 

■DDCOMPT, VP,DSNAME=COMPTL1B,OPTION=JOBLIB' 
f DOM AT ,VP,DSNAME“MATLIB,CPIICM=J0BLIB* 

CPUTIT,, ,E 

CHCIWI FORTRAN RETURN TO SYSTEM 

13,4(0,13) 

(14,12) 

LI 8DEF, 1 5 
( 14,12) 

14,7210,13) GET PSECT COVER REG 

tOMPUT#P,l4 

I2,SAVE2 

12,8(0,13) 

13,4(0,12) 

13,12 

12 # ACCOM PT 
15 

COMPUTE, 12 

START DATA DEFS FOR INITIAL 
■FT05F001, VS, OSNAME^KEY WORDS 1 

END DATA OEFS FOR INITIAL 

13,4(0,13) 

(14,12) 
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USING 

LI BREL, 15 

SAVE 

1 14,12) 

L 

14,72(0,13) 

iA 

12.SAVE2 

ST 

12,8(0,13) 

ST 

13,4(0,12) 

LR 

13,12 

USING 

C OMPUT # P , 1 4 

L 

12 , ADCOMPT 

DRCP 

15 

USING 

COMPUTE, 12 

REL 

* F T05F00 1 * 

i 

13,4(0,13) 

RETURN 

END 

(14,12 I 


GET PSECT COVER REG 


START DATA RELS FOR INITIAL 
END DATA RELS FOR INITIAL 


COMPUTE 

FORTRAN PAIN PROGRAM, DECK NAME COMPUTE 
COMMON /MOD El /DEBUG, PROCED 
LOGICAL DEBUG, PROCED 
PROCED = -FALSE. 

CALL CPUTIT 

RETURN 

END 


CPUTIT 

SUBROUTINE CPUTIT 
DIMENSION INPUT (441 ) » N M ( 3 ) 

CCMMCN/MODE1 /DEBUG, PROCED 
LOGICAL NUM,I$TART, DEBUG, PROCED 
DATA 1ST ART/. TRUE-/ 

PROCED = -FALSE. 

IF ( I START ) CALL INITAL 
I STAR Tjs. FALSE . 

2 CALL REACIH INPUT, NM,K,NUM,ILP,IRP, I EQ, ICM, IOP* ILST ) 

IF I ILST.EQ.C J GO TO 20 

10 IF t IIP. EC. 0. AND- IRP.NE.O } GO TO 11 
IF! IRP.G6.ILP) GO TO 12 

11 CALL MSGU,NMm,NM(2I,NM(3)l 
GO TC 2 

12 IFUEC.NE.O) GO TO 14 

IF(NUM.OR.ICM.NE.O.OR.( I OP . NE .0. AND. IOP. LT. I LP I) GOTO 18 

IF1K.LE.12) GO TO 121 

CALL MSG( ?,NM( 1) ,NM(2) , NMI3) ) 

GO TO 2 

121 CALL COMMNDf NM, INPUT, IL P , 1 l ST , E13 I 
GO TO 2 
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13 IF(.NCT.PROCED) RETURN 

CALL MSGI8»NMm ,NM(2) ,NMI3I > 

GC TC 2 

14 IF ( IQM.NE.O) GO TO 16 
IFIK.GT.8I GG TO 19 
IF ( NUM) GO TO 18 

IFUCP.NE.O.AND.IOP.LT.IEQ) GO TO 18 
IF ULP. EC.O.ANO. IRP.EQ.O) GO TO 141 
IFULF.LT.IEG.AND.IRP.LT. IEQ) GOTO 15 
141 CALL NM£CEX(NM(2)#INPUT,IEQ+1*ILST) 

GO TO 2 

15 CALL FNEGEX<NM(2), INPUT, ILP , IRP, I EQU , ILST! 

GO TO 2 

16 IFULST.GT.ICMJ CALL MSG ( 6 , NM (I) , NM I 2 ) , NM ( 3 U 
IF(NUM) GO TO 17 

IF{ IRP.NE.O.AND. IRP.LT. IEQ) GO TO 17 
IF (ICP.NE.O.ANO.ICP.LT. IEQ) GO TO 17 
IFIK.GT.8) GO TO 19 
CALL NMECGS [NM 12) ) 

GO TO 2 

17 CALL eXECQSIINPUT,IEQ-n 
GO TO 2 

18 CALL MSG 12 ,NM (1 ) ,NM(2 >,NM (3) ) 

GO TO 2 

19 CALL MSGI3»NM( l ) * NM { 2 ) * NM ( 3 ) I 
GO TO 2 

20 CALL MSG( lll.A t 8,C) 

GC TC 2 

END 


READIT, READIT1 

SUBROUTINE READITIINPUT , NM, K,NUM,I LF, I RP» IEQ. IQM, IOP» ILST ) 
DIMENSION I NPUT ( 1 ) * NM ( 1 ) 

COMMON /PROCDS/NPCDjLASTI , ICNT, IUSPCD(2000) 

CCMMCN /MODEl/OEBUG.PROCED 
LOGICAL DEBUG, PROCEC 

INTEGER CAT,BLK»EG»GM»AS,SH,PL»TEMP,TEMP1»RP,DP» AP 

LOGICAL NUM.APS 

DATA RP*CP,AP/M* t *. MHV 

DATA CAT, 8LK,EQ,QM»LP,AS»SH,PLfMI, MASK X * ( * , * , *4 • , 

*•/’ ♦ *+*,*-• ,2F0404040/ 

KALL = 1 
GO TO 2 

ENTRY REACT 1 I 1 NPUT , NM , K , NU M , ILP t IRP. I EQ, IQM , IOP, ILST) 

KALL = 2 
2 K = 0 
NM ( 1 }=BLK 
NM( 2 )*BLK 
NM{ 3 J-BLK 
NUM * .FALSE. 

APS * .FALSE. 
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ILP = 0 
IRP = 0 
IEQ = 0 
IQM = 0 
IOP = 0 
1LST = 0 
KCM = 0 
DO 1 1=1,441 
1 INPUTU ) = 8LK 

IF ( KALL- EC.2 ) GG TO 21 
IFI.NOT.PRGCF01 CALL MSGU,A,B,C) 

IF(PROCED) CALL MSG ( 86 , I U SPCD ( ICNT ) , A , B 1 
21 DO 9 J=1 , 3 

N 1= 120*1 J— 1 )*1 
N2 = 120* J 

READ 101,1 INPUT I I >, I = N1 ,N2) 

DO 8 I=N1,N2 
T EM P= IN PUT ( I > 

IFUEMP.NE.CAT) GO TO 4 
INPUTU ) = BLK 
GO TO 9 

4 IF (TEPP.EC.BLK) GO TO 8 
IFUEMP.NE.AP) GO TO 41 
INPUT U > = ELK 
APS = -NCT.APS 
KOM = 1 
GO TO 8 

41 I F ( .NCT.APS) GO TO 42 
INPUTU) = BLK 

GO TC 8 

42 IF! ILST.NE.C ) GO TO 3 

11 TEMPI = I SRU24, TEMP-MASK 1 

IF (TEMP-EQ-CP.OR. (TEMPI. GE.O.ANC.TEMPl-LE-9 ) ) NUM = -TRUE. 

3 ILST = I 

IF1 ILP.EC.C.AND.TEMP.EQ.LP) ILP = I 
IFURP-EQ.O-AND.TEMP-EO.RP) IRP = 1 
IF( IEO-EO.O. AND. TEMP. EQ.EQ) IEQ = I 
IFIICK.EO.O. AND. TEMP. EQ.QM) IQM = I 

IF ( IOP.EQ.O.ANO. ( TEMP. EQ. AS. OR. TEMP. EQ.SH.OR.TEMP.EQ.PL. OR. TEMP 
*.EQ.MI) ) ICP = I 
IF I ILP.NE.O.OR. IEQ.NE.O) GO TO 8 
K = K + l 

IFIK.GT.12) GO TO 8 

NM(l) * ISLLI8,NMI1))+ISRL(24,NM(2)) 

NM(2) = ISLL18,NMI2) ) + ISRL(24»NM(3 ) ) 

NM<3) = ISLLt8,NM|3) )+ISRL(24,TEMP) 

8 CONTINUE 
GO TO 10 

9 CONTINUE 

CALL MSGI9,NMI1 ),NM12),NM(3) ) 

GO TO 2 

10 IFULST.EQ.C.AND.KOM.EQ.l) GO TO 2 
RETURN 

101 FORMAT (120A1) 

END 
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INITAL 


SUBROUTINE INITAL 
IMPLICIT INTEGER I A-Z ) 

COMMON /NAMES/NMLT,NAME( 100 I, VALUE [50 1 
COMMON /FCTS/NFCT.LSTI , IUSFCT ( 1000) 

COMMON /PROCDS/NPCO,LASTI, ICNT,IUSPCDt 2000) 

COMMON /M00E1 /DEBUG, PROCED 

COMMON /ACMDS/NAXCMD,AUXCMO( 3,331 t PGM! 2, 33) 

DIMENSION INKEY(3),SYSKEY(3 ), INPUT (120 ) ,COMMND( 3 ), PROG ( 2) , 

*NEYWRD( 3,20) ,NCNNDS(20 ) ,CMNDS (3 ,33 ,20 ) , PGMS t 2, 33,20 ) 

DATA SY5KEY»YES,N0 , 8LK/ • . LA • , • MPOO* , *N. * , * YES» , »N0' , » »/ 

LOGICAL DEBUG, PROCED, HERE, MOO 
DATA HERE/. FALSE./ 

IF (PROCED i GO TO 101 
DEBUG *. FALSE. 

NMLT=0 
NFCT = 0 
LST I = 0 
NPCD = 0 
LASTI * 0 
MOO = .FALSE. 

CALL LI8DEF 
IF(HERE) GO TO 1 
HERE = .TRUE. 

REWIND 5 

READ <5,20l,END=l) NKEYS , KE YWRD, NCMNDS,CMNDS, PGMS 

201 FORMAT 1 1 A , 3 l / , 20AA J » / , 20 I A, 1 65 1 / , 20A4 )) 

1 IF(MCD) GO TO 37 
CALL MSG ( 1 39, A, B»C) 

NCMNO = 0 

READ 202, INKEY 

202 FORMAT ( 3 AA } 

I F ( IN KEY d ) -EQ.SYSKEYt 1 J.AND. I NKEY I 2 » . EQ . SY SKE Y (2) . AND. INKE Y( 3) 

+ .EQ.SYSKEY( 3 I) GO TO 7 

IF ( INKEYt 1 ) .NE.BLK.OR. INKEYi 2 ) .NE . BLK -OR _ INKE Y ( 3 > . NE . BL K > GO TO 2 
NAXCMD - 0 
GO TO 99 

2 IF(NKEYS.EQ.O) GO TO A 
DO 3 1*1, NKEYS 

II = I 

IF( INKEY(l) .EC.KEYWRDd, d . AND. INK EY ( 2 ) .EQ . KE YWRD I 2 , I ) . AND . 
*INKEY(3).EQ.KEYWRD(3,d) GO TO 5 

3 CONTINUE 

A CALL MSG ( 1 AO , A, B, € } 

GO TO l 

5 NAXCMD = NCMNDSdl) 

DO 6 J* 1 , NAXCMD 

AUXCMO { 1 , J } * CMNDS ( 1 , J, I I ) 

AUXCMD { 2, J ) = CMNDS(2,J,m 
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AUXCMO 1 3 » J ) = CMND$(3,J,m 
PGMII.J ) = PGMSd.J.II) 

PGM (2 » J ) = PGM S l 2 * J * II ) 

CALL LOAOIPGMU , JJ.KOOE) 

GC TO (6*51) i KOD E 

51 CALL MSG1I34*PGM(1*J) *PGM(2*J),A) 

6 CONTINUE 
GO TC 99 

7 IF { NKEYS. EQ.O ) GC TO 9 
CALL MSG(141,A,B,C> 

PRINT 203* ( I*KEYWRD( 1, I ),KEYWR0(2, I ) . KEYWRD1 3 * I). 1=1, NKEYS) 

203 FORMAT (* *,I5,2H *,3A4,1HM 
GO TO 10 

9 CALL MSG{142,A,B,C) 

10 CALL M SG ( 143 , A , 6 » C ) 

READ 202* INKEY 

I F ( INKEY( 1 ).EQ.SYSKEY{1 ). AND. INKEY t 2 ) . EQ . S Y SKE Y l 2 ) . AND . INKF Y ( 3 ) 
*.EQ.5YSKEY( 3)1 GO TO 11 

I F 1 INKEY (1) .EQ.BLK.AND.INKEYm.EQ.BLK.AND. IN KEY (3 ) . EQ. BLK ) GO TO 
*11 

GO TD 12 

11 CALL MSG(14O*A,0,C) 

GC TO 10 

12 IFINKEYS.EQ.O ) GO TO 14 
OC 13 1=1, NKEYS 

II = I 

IF! INKEY( 1) .EC.KEYWRDt 1, I >.AND„ I NKE Y ( 2 ) - EQ. KE YWR D 1 2 » 1 ) .AND. 
*INKEY13) .EQ.KEYWRDf 3. I) > GO TO 15 

13 CONTINUE 

14 CALL MSGI 144*A,e,C) 

MOD = .TRUE. 

NKEYS = NKEYS+1 

KEYWRD 1 1 .NKEYS) = INKEY(l) 

KEYRPDI2.NKEYS) = INKEYI2I 
KEYWRD13, NKEYS) = I NKE Y (3 ) 

II = NKEYS 
GC TC 22 

15 NCMNO = NCMNCS(II) 

IF ( NCMND.EG .0 ) GC TO 16 

CALL MSGI145*INKEY(1)» INKEY12)* INKEY 13) ) 

PRINT 2 04* ( J *C MNDS ( 1,J,II) * C MNOS ( 2 , J * II J , CMND S ( 3 , J * 1 1 ) , 

*PGMS( 1»J* II ),PGMS(2*J, I I ) * J=l, NCMNO ) 

204 FORMAT (* ',I5»2H •* 3A4 , 1H •* 4X ,* CALLS *, 4X * 1 H* , 2A4* 1 H » ) 

GO TC 161 

16 CALL MSGI146, INKEY(l), INKEY 12 >, INKEYI3) ) 

161 CALL MSG( 151* INKEYf 1), I NKE Y (2 ) *INKEY(3) ) 

READ 202»TEST 

IFITEST. EC.YES.OR.TEST.EQ.NO) GO TO 162 
CALL MSGI 14C,A,B,C) 

GO TC 161 

162 If(TEST.EQ.NC) GO TO 1 
MOD = .TRUE. 

163 CALL MSGI 147* INKEYl 1 } , INKEYI 2 ). INKEYt 3) ) 

READ 202*TEST 
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GO TO 17 


IF 1 TEST .EQ.YES.OR.TEST-EO.NO ) 

CALL MSG 1 14C ,A,B,CJ 
GO TO 163 

17 IF(TEST.EG.NO) GO TO 22 
IF( II.EG.NKEYS) GO TO 19 
DO 18 1= I I » NKEYS 
KEYWRD ( 1 * I > * KEYWRDU, 1 + 1 ) 

KEYWR0(2,n = KE YWRC 1 2 * 1 + 1 1 
KEYWRD ( 3 » I I * KEYWRDU, I + t) 

NCMNDS f I ) = NCMNDS1 1 + 1 ) 

DO 18 J=1 *33 

CMNDSU,J,I) = CMNDSl l, J,I+1) 

CMNDS( 2 *J,n = CMN0S(2,J»I+1) 

CMNDSl 3 * J» I ) * CMNDSl 3. J, 1 + 1) 

PGMS(lfJfl) = PGMS1 l, J, 1+1) 

18 PGMS 12* J* 1 1 * PGMSI2*J*I+1) 

19 NKEYS = NKEYS- 1 

20 CALL MSGU48,A,8,C) 

READ 202, TEST 
1F1TEST.EQ.YES.OR.TEST.EC.NO) GO TO 21 
CALL MSGU4C,A,8,C) 

GO TO 20 

21 IF (TEST. EC. YES ) GO TO 37 
MOD = .TRUE. 

GO TO 10 

22 CALL MSGfl49,A,B,C) 

READ 205, INPUT 

205 FORMAT (120A1) 

CCMMNCm = ELK 
CCMMNC12) = BLK 
COMMND ( 3 ) = BLK 
K * 0 

DO 23 1*1, 12C 

If UNPUTm.EQ.8LK) GO TO 23 
K = K + l 

IflK.GT.12) GO 70 24 

COMMND 1 1 ) * ISLLf 8,CCMKN0(1) )+ISRL ( 24 »COMMND 1 2 ) ) 
CCMMN0{2> = ISLL(8,C0MMND(2) )+ISRL(24,CCMMN013) ) 
COMMND ( 3 ) = ISLL(8*CCMMND(3) )+I SRL 1 24* INPUT 1 I ) ) 

23 CONTINUE 

IF ECOMMNO 13 ) .NE.BLK ) GC TO 25 

24 CALL MSG(140*A,8,C) 

GC TO 22 

25 CALL MSG 1 150 * A* 6. C ) 

R FAD 205, INPUT 
PROG 1 1 ) * BLK 

PROG ( 2 ) * BLK 
K = 0 

DO 26 1*1, L2C 

IF! INPUT 1 1 J.EQ.BLK) GO TO 26 
K * K+l 

IF1K.GT.8) GO TO 27 

PROG 1 1 ) = I SLLt8,PRCG 11 ) ) + ISRL (24, PR0G1 2 I ) 

PROG 1 2 ) = ISLL l 8*PR0G(2 ) ) + l SRL1 24, INPUT1I >1 
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26 CONTINUE 
GO TO z a 

27 CULL MSG I 140 , A » fi * C ) 

GO TO 25 

28 IF(NCMND-EQ.O) GO TO 30 
DC 29 J=1 , NCMNO 

JJ = J 

IFICCHMNDU ).EQ. CMNOS (1, J » III . AND.COMMNO (2 ) . EQ -CMNOS t 2 , J, II) 
♦.AND.COMMND (3).E0.€MNDS(3,J,I II I GO TO 31 

29 CONTINUE 

30 NCMND » NCNND+l 
NCMNDSUI) = NCMND 
JJ = NCMND 

CMNOS ( 1 t J J i I I ) = CCMMND(l) 

CMNOS ( 2 i J J , I I ) = CCMMND ( 2 ) 

CMNOS (3, J J, 1 1 ) = CCMMND 13) 

31 IF(PR0G12).EC.BLK) GO TO 32 
PGHS 1 1 , J J, I I ) = PROG (II 
PGMS(2,JJ,II> = PROG 12 J 

GO TO 35 

32 IF (JJ. EG. NCMND) GO TO 34 
DO 33 J- J J t NCMND 
CMNDSIltJ.m = CMNDSU,J + 1»1I) 

C MNDS ( 2 , J* 3 I ) = CMNDS(2,J*1,I I) 

CMNOS (3 , J , I I ) = CHNDS ( 3 , J + l » 1 1 I 
PGHSU,J,in = PGMS(1,J+1,II) 

33 PCMSI2,J,II) = PGHS (2 » J* 1,1 I I 

34 NCHND = NCMND— 1 
NCMNDS I II) * NCMND 

35 CALL MSGt 14e,A.B,C) 

READ 202, TEST 

IFITEST.EG.YES.OR.TEST.EO.NO) GO TO 36 
CALL MSG { 140 , A, B ,C) 

GO TO 35 

36 IF(TEST.EC.YES) GO TO 37 
GO TO 22 

37 MOD = .FALSE. 

REWIND 5 

WRITE (5,201) NKEYS,KEYWPD, NCMNOS, CMNOS, PGMS 

END FILE 5 

CALL MSG(152,A,8,C) 

GO TO 1 

99 CALL MSG(11,A,B,C) 

CALL LI BREL 

100 RETURN 

101 CALL MSG 1 12 , A, 6, C ) 

GO TO 100 

END 
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NMEQQS 

SUBROUTINE NMEQQSINH1 
DIMENSION NHI1I 

CCMMCN/NAMES/NMLT, NAME! 100 1 ,VALUE(50» 

COMMON /FCT$/NFCT»LSTI , IUSFCT ( 1000) 

COMMON /PR0CDS/NPC0»LA5TI, ICNT, IUSPCD(7C00) 

COMMON /MGDE1/DESUG,PR0CE0 
LOGICAL DEBUG,PROCED 
I F { PROC EE ( GO TO T 
CALL FNDNAMtNM, I ,KOOE) 

GO TQ(1,2,3.4,5,6),KGPE 

1 CALL M$G(41»NMI11»NM(2),NM13) ) 

GO TO 100 

2 1 2“ 1/2+1 

CALL MSG177tNMIl )»NM( 2), VALUE (12)1 
GO TC LOO 

3 CALL MSG(42»NM(1),NM(2>,IU$FCT(I+31/2I 
GC TC 100 

A CALL MSG(43,NMU),NMI21,NMI3n 
GC TO 100 

5 CALL M$G(44,NMm,NM(21,NM(311 
GO TO 100 

6 CALL MSG(133tNM(ll»NM(2),NM(3) 1 
GC TO LOO 

7 1FILASTI+4.GT. 19961 GO TO 8 
IUSPCOI ICNT1 * IUSPCOI ICNT1+1 
LASTI = LASTI+1 
IUSPCO(LASTI 1 = 2 

LASTI = LASTI+1 
IUSPCC ( LAST l) - 2 
LASTI = LASTI+2 
IUSPCD(LAST I — 1 ) = NM I 1 1 
IUSPCOI LAST I) = NM (2 ) 

GO TO 100 

8 PRCCED = .FALSE. 

LASTI = ICNT-4 
NPCO = NPCD-1 

CALL MSG ( ILC, IUSPCOI LASTI *1 1. IUSPCOI LASTI+2 ), A 1 
ICO RETURN 
END 


EXEQQS 

SUBROUTINE E XECQ S 1 1 NPUT , I E XND ) 

DIMENSION INPUT 111 

CCMMCN /PPCCOS/NPCD, LASTI, ICNT , IUSPCD I 20001 
COMMON /M0DE1/DEPUG, PROC EO 
LOGICAL DEBUG, PRCCED 
IS = 1 

I F ( PROC ED ) GO TO 2 

CALL EVALI INPUT, I S , I EXND, ANS » E 1 1 

CALL MSG (78 , ANS,A,B 1 

GO TO ICO 

1 CALL MSG (45, A, B, Cl 
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GO TO IOC 

2 CALI PRESS2I INPUT, IS, IEXND.SIOO) 
IFILASTI+IEXND+2.GT.1996) GO TO 4 
IUSPCD! ICNT ) = I USPCOI ICNTI+1 
LASTI = LASTI+1 

lUSPCD(LASTI) » IEXND 
LAST! = LASTI+1 
IUSPCCMLAST! ) * 3 
DC 3 I=1,IE>ND 
LASTI « LAST 1 + 1 

3 IUSPCD ( LAST I J * TNPUTII I 
GO TO IOC 

A PROCEO « .FALSE. 

LASTI * ICNT-4 
NPCO = NPCO-1 

CALI MSG ! 110, IUSPCD (LAST I + 1 ) , IUSPCD ( LASTI +2 > , A ) 
100 RETURN 
END 


NMEQEX 

SUBROUTINE NMECEX(NM, INPUT , I EXST, IEXND ) 

DIMENSIGN NM(l),INPUT(l) 

COMMON /PRCCCS/NPCD,LASTI,ICNT, IUSPCD 12 COO) 

CCMMCN /FODE l /DEBUG* PROCEO 
LOGICAL DEBUG, PROCEO 
IMPRCCEC) GC TC 2 

CALL EVAL U NPUT , I EXST , I EXNO , A N S , € 1) 

CALL NMECNU 1 NM, ANS) 

GC TC 100 

1 CALL M$G146,NH{ 1) * NH 12 ) , NM I 3 ) ) 

GO TO ICO 

2 CALL PRESS2 (INPUT, IEXST, IEXND, €100 ) 

IF (LASTI+IEXN0+4.GT.1996) GO TC 4 
IUSPCDIICNT) ® IUSPCD [ ICNT )+l 
LASTI * LASTI+1 

IU 5 PCD 1 LA ST I ) = IEXND+2 
LASTI = LASTI+1 
IUSPCD 1 LA ST I ) = 1 
LASTI = LAST I +2 
IUSPCD (LAST 1-1 ) = NM1) 

IUSPCD! LASTI) * NMI2) 

DC 3 1=1, IEXND 
LASTI = LASTI+1 

3 IUSPCD! LASTI) = INPUTII ) 

GC TO 100 

4 PROCEO * .FALSE. 

LASTI * ICNT-4 
NPCD * NPCC-I 

CALL MSG (11C, IUSPCD I LAST I ♦!)» IUSPCD! LAST I +2 ), A ) 

ICO RETURN 
END 
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FNEQEX 

SUBROUTINE FNEQE X f NM , I NPUT , I L P , IRP , I S * I E ) 

DIMENSION NM tl ) » INPUT (1) .NM 1 ( 2 ) 

COMMON /FCT S/NFC T, LSTI, I USFCTI1 OQO) 

CCMMCN /MODE 1/ DEBUG, PROCED 
LOGICAL CEEIG, PROCEO 
INTEGER BLK , TEMPtCM 
DATA 8LK«CM/ • *,*,'/ 

IF {PROCED) GO TC 8 
CALL FNONAMtNM* I f KODE J 
GO TO{2, 12, 9, 10. 11,13). KODE 

12 CALL MSGC47»NM(ll,NMI2 )»NH(3) I 
GO TO 100 

9 CALL MSG(48»NMtl>fNM(2),NMt3l> 

GO TO 100 

10 CALL MSGI 53,NM(1) ,NM{2) »NMI 3) ) 

GO TO 100 

11 CALL KSG(54,NM(1) »NM (2) ,NM ( 3 ) I 
GO TC 100 

13 CALL MSG(136tNMCl>fNMI21fNM(3)) 

GO TC ICC 

2 NFCT = NFCT+t 
L ST 1 = LSTI+2 

IUSFCT ( LST I— 1 ) = NM ( 1 ) 

IUSFCTtLSTI) * NMC2) 

LSTI = LSTI+i 
LSTS = LSTI 
N 1 a ILP+1 
N3 = IRP-1 

IF(NUGT.N3> GO TO 6 
LSTI = LSTI+1 
LSTA = LSTI 
I = 0 

3 NM 1 (!) * BLK 
NM 1 1 2 ) = BLK 
K = 0 

N2 = M 
DO 32 J“N2 , N3 
N 1 a Nl + 1 
TEMP a INPUT ( J) 

IF (TEMP. EQ.BLK ) GO TO 32 
IF f TEMP.EQ.CM ) GO TO 33 
K = K + l 

IF(K.GT.g) GO TO 7 

NM1I1) = ISLL(8*NM11 1) )+ISRLt24,NMl(2) ) 

NM1 { 2 ) = ISLU8,NMl(2)) + ISRL{24, TEMPI 

32 CONTINUE 

33 IF(K.EG.O) GO TC 6 
IF ( 1 .EQ .20) GO TO 14 
I = 1*2 
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LSI I * ISTI+2 
IUSFCmSTl-1) * NM1U) 

IUSFCT (LSI I ) = NM112) 
IFIN1.LE.N3> GC TO 3 
lUSFCTtlSTM * 1 
CALL PRESS2 ! INPUT , IS, IE, £31) 
IFUSTI+IE.LE.1000) GO TO 4 
CALL M$G(49,NM( 1 ),NM ( 2 ) , NM ( 3 ) ) 
31 LSI! * LSTS-3 
NFCT = NFCT-1 
GO TO 100 

4 DO 5 1=1. IE 
LSI I = LSTI+1 
IUSFCTILSTI) = INPUT ( I > 

5 CONTINUE 

IUSFCT (LSTS ) = LSTI+l 
GC TO 100 

6 CALL MSG ( 50 »NM ( l)»NM!2)»NM(3> ) 
GC TO 31 

7 CALL MSG!51,NM(1)»NM(2)*NMI3) ) 
GO TO 31 

8 CALL MSG(52»NM(1)»NN(2)»NM(3)) 
GO TO 100 

14 CALL MSG ( 126 ,A , 8 »C ) 

GC TO 31 
100 RETURN 
END 


NMEQNU 

SUBROUTINE NKECNU (NM , ANS ) 

OIMENSICN NM ( 1 ) 

COMMON/NAMES/NMLT.NAMEI 100 >, VALUE I 50) 

COMMON /MODE! /DEBUG. PROCEO 
LOGICAL DEBUG, PROCEO 
CALL FNDNAM (NM, I,KOOE> 

GO TO! I ,2.4, 5.6,7) .MODE 
212= 1/2+1 
VALUE ( 12 )=ANS 

IF(OEBUG) CALL MSG ( 77.NM !1 » , NM 12 ) , VALUE { 12 )) 

GO TO 100 
1 NMLT®NMLT+2 

IF INMLT.EG.98) CALL MSG 1 66 ,NM 1 1 ) ,NM 12 ) , NM (3 ) ) 

IF(NMLT.GT.IOO) GO TO 3 
NANElNMLT-1 )«NMC1> 

NAME ( NMLT )=NMI2> 

JJ = NMLT/2 
VALUE I J J) = ANS 

IF ! DEBUG ) CALL MSG! 77.NMU ) ,NM !2 ) , VALUE I J J )> 

GC TO 100 
3 NMLT* IOC 

CALL MSG(67»NM[ 1I.NMI2) ,NM(3H 


32 



n o n n o n n r> # # * * o * 


GO TO IOO 

A CALL MSG (79, ANS, NHI 1 J , NM { 2 ) 1 
GO TO 100 

5 CALL MSG I80»ANS»NMIl) , NM (2 ) J 
GO TO 100 

6 CALL MSG (81 »AN$»NM{ 1 ) , NM(2 ) ) 
GO TO ICO 

7 CALL MSG ( 131 »AN5 »NM{ 1 ) , NHI 2 ) ) 
100 RETURN 

END 


NMBR 

SUBROUTINE NMBR t INPUT ,N1 ,N2 , ANS,* ) 

DIMENSION INPUT ( I ) »N8R ( 40 1 
INTEGER ELK, RP, TEMP, CHAR 
REAL*8 ARG2 

DATA BLK*LP , RP/ * *,'<*,*>■/ 

NBR 1 1 ) = LP 
CO 1 I=NI,N2 
T£MP= INPUT { I ) 

IFITEMP.EQ.BLK1 GO TO 1 
J=J + 1 

IF(J»GT.39) GC TO 2 
NBRf J}=INPUTII1 

1 CONTINUE 
J=J + 1 
NBP(J)=RP 
KTR * 1 

CALL CNVRT (NER#KTR»4Q, 1,ARG1*ARG2, CHAR ,63, £3, £4) 

ANS=ARG1 

RETURN 

2 CALL MSG174, A, 6,0 
RETURN 1 

3 CALL MSG ( 75, A, B ,C ) 

RETURN 1 

A CALL MSG ( 76 »CH AR , A, B ) 

RETURN 1 
END 


CNVRT 

SUBROUTINE TC CONVERT A TYPE INPUT TO FLOATING POINT NUMBERS 


INPUT 

ARRAY OF CHARACTERS. ONE PER 

WORD LEFT ADJ. 

KTR 

INDEX OF FIRST WORD OF ARRAY 

TO BE CONSIDERED 

MAX 

DIMENSION OF INPUT 


TYPE 

*1 REAL+4* ~2 RE AL*8 


ARG1 

REAL** ANS 


ARG2 

REAL*8 ANS 


CHAR 

BAD CHARACTER IF FOUNO 
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RETURN NEXT CHARACTER ) RESULT GOOO 

RETURN 1 NO * OR ) POUND RESULT ZERO 

RETURN 2 NEXT CHARACTER , RESULT GOOD 

RETURN 3 BAC CHARACTER RESULT ZERO 

SUBROUTINE CNVRT I INPUT * KTR » MAX* TYPE* ARGI* ARG2» CHAR » *,*,*) 
INTEGER INPUT! 11, TYPE ,TEMP ,T£MP 1 *CHAR 
REAL* A ARG1 
REAL*8 ARG2 

INTEGER 8LK,RP* Pl»DP*E * D*CM 

DATA MASKl,BLK,LP,RP*PL,MI , DP, E, D,CM/ZF0A040A0* • • * 

**-■ , ».*,»E< ,*D *»*,*/ 

IEXP * 0 

IP = l 

ISGN = 1 

ARGI * C.C 

ARG2 = C-ODC 

SIGN = 1.0 

NUM = 1 

ISTART * KTR 

DC 20 I=ISTART,MAX 

KTR * I 

TEMP * INPUT ( 1 1 

IF I TENP.EQ. ELK 1 GO TO 20 

GO TO I8,9,9,9»9,9J»NUM 

8 IF1TEHP.NE.LP.ANC.TEMP.NE.CM) GO TO 23 
NUM * 2 

GC TO 20 

9 lF!T£KP.EC.RP.OR.TEMP.EQ.CM) GO TO 22 
GC TO ( 10, 10, 13*15, 17, 19), NUM 

10 NUN = 3 

IFITENP.NE.PL ) GO TO 11 
GO TO 20 

11 IFITEMP.NE.NI 1 GO TO 13 
SIGN * -1.0 

GO TO 20 

13 IFtTEMP.EO.E.GR.TEMP.EQ.D) GO TO 151 
IF(TEMP.NE.EP) GO TO 1A 
NUN = A 
€0 TO 20 

IA TENP1 = ISRL ( 2A» TEMP-MASK 1 1 

IF(TENPi.LT,0.0R.TENPl.GT.9 > GO TO 23 

IF! TYPE .EG. 1 ) ARGI = ARGI* 10 .O+FLOAT fTEMPl ) 

IF (TYPE. EC. 2 ) ARG2 = ARG2* 10.0D0+CBLE ( FLOAT! TEMPI ) ) 

GO TO 20 

15 IFITEMP.NE.E. AND. TEMP. NE.Cl GO TO 16 
151 NUN * 5 

GO TO 20 

16 TENP1 * ISRL (2A»TENP-MASK1 1 

IFtTE NP i.LT.O. OR. TENP1-GT. 91 GO TO 23 

IF( TV PE. EC. H ARGI = ARG1+FL CAT! TEMPI) /10.0**IP 

IF(TYPE.EC.2) ARG2 • ARG2 + DBI El FLOAT (TEMPI > )/10.0DO**IP 

IP * IP+1 

GO TO 20 

17 NUN * 6 
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noonnnoo 


GO 10 18 


I F ( TEMP *N£ * PL ) 

GO TO 20 

18 I F ( TEMP •NE.H I ) GO TO 19 
1SGN * -1 

GO TO 20 

19 TEMPI = I SRI (24 » TEMP-MASK 1 I 
IF(TEMP1*LT*G.GR*TEKP1*GT*9) GO TO 23 
l£xp = IEXP*10*TEHP1 

20 CONTINUE 
ARG1 - C*0 
ARG2 * 0*000 
RETURN 1 

22 IF(TYPE*EG*1) ARGl = S I GN*ARG l* 10* 0** ( I $GN*IE XP ) 

I F C TYPE*EQ*2 } ARG2 = $ IGN*ARG2*1O.0OO** ( TSGN* I EXP ) 

IFtTEMP.EG.CM> RETURN Z 

RETURN 

23 ARGl = C.O 
ARG2 - 0.000 
CHAR = TEMP 
RETURN 3 
END 


SUBROUTINE 

m 

l 

KODE - 1 
2 
3 
A 

5 

6 

DIMENSION NMfl) 

COMMON /N A ME $ /NML T * NAME ( 100 > t VALUE ( 50 } 

COMMON /FCT3/NFtT,L$TI, IUSFCK 1000 J 
COMMON /PROCDS/NPCD, LASH * IC NT * I US PC D l 2000 ) 

COMMON /MODE I /DEBUG # PROCED 
ICG I C At CEBUGt PRCCEO 
I F f NML T * EG. C J GO TO 3 

00 1 J- 1 1 NML T * 2 
I*=J 

IF1NMC1 I.EQ.NAMEI JJ.AN0.NMf 2) .EG. NAME! J + l H GO TO 2 

1 CONTINUE 
GO IC 3 

2 12 = 1 / 2+1 

IF t DEBUG » CALL MSG ( 77 * NM C i > f NM t 2 ) » VALUE (1 2 ) > 

KCOE = 2 
GC TC 100 

3 IF INFCT *EQ.€ > GC TO 6 

1 = l 

00 A J= 1* NFCT 


F NON AM (NMfI T KCOE} 

NAME TO SEARCH FOR 
INDEX OF NAME 
NAME NCI FOUND 
VALUE NAME FOUND 
USER FUNCTION NAME FCUND 
PROCEDURE NAME FOUND 
SYSTEM FUNCTION NAME FCUND 
USER PROGRAM NAME FOUND 


FNDNAM 
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IFtNHm.EQ.IUSFCTd J.AND.NMm.EQ. IUSFCTU + 1H GO TO 5 
I = IUSFCTU+21 

4 CONTINUE 
GO TO 6 

5 KODE = 3 
GO TO 100 

6 IF ( NPCD ,£Q. G ) GO TO 9 
I = 1 

DO 7 J=1 * NPCO 

IFCNMtll.E0.IUSPCDm.AN0-NHl2).EQ-IUSPCDU+in GO TO 8 
I * IUSPCD1I+2) 

7 CONTINUE 
GO TO 9 

8 KODE = 4 
GO TO ICO 

9 CALL PGMNAMINM,!) 

IF(I.EG.C) GO TO 11 
KODE = 5 

60 TO ICO 

11 CALL LGAGEC ( NM , I l 
GO TO 112,131*1 

12 KODE = 6 
GC TO IOC 

13 KODE = 1 
ICO RETURN 

201 FORMAT I * • ,2A4 * *= » ,G14 . 6 ) 

END 


PRES SI, PRESS? 

SUBROUTINE PR ESS 1 ( I NPUT , I S , !E,*J 
DIMENSION INPUT (1 ) * NM ( 2 ) ,IN1(88), INTMPt 441 ) 

LOGICAL NER ,RESLV,EF 

INTEGER X,TEMP,81K,RP,SH,AS,AS2.PL, DP,E,D,CM 
COM M.ON/NAMES/NMLT, NAME! 100) , I VALUE! 50 1 

DATA MASK»BLK»LP*RP»5H,A$,PL»MI, AS2 /ZFG4C4040* * •*' (*»•)' ,*/•***’ , 
l'** ,***’/ 

DATA I NT/ ' INT*/ 

DATA OP»E*D»CM/*. *#'£*, *0 * » * » * / 

NBfifXI - ISRt<24*X~MASK>.G£.Q .AND* ISRL 124* X— MASK J .LE. 9 
RESLV = .TRUE* 

GO TO 22 

ENTRY PR ES 52 ( INPUT, IS* I E »* 3 
RESLV = -FALSE. 

22 IPRN = 0 
K = 0 

NUM ST = 0 
EF = .FALSE. 

J = 1 

INTMPU) = LP 
NMI 1 ) = BLK 
NM ( 2 ) ~BLK 
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! END = IE + 1 

INPUTIIENO) « BLK 

DC 8 1= I $ » I END 

IFt I.EQ.IENC) GO TO 1 

IEIJ.6T.438J GD TO 15 

IFt INPUT! II .EQ.BLKJ GO TO B 

TEN P= INPUT (I ) 

IF (TEMP. EG. LP) IPRN * IPRN+1 
IF I TEMP.EQ.RP) IPRN = IPRN-l 
IF I IPRN.LT.OJ GO TO 14 
IF(TEMP.NE.PL.AND.TENP.NE.WI) GO TO 17 

IFtlNTNPtJI.NE.UP. AND. INTMPtJJ. NE.CN.GR. K.NE.O) GO TO 16 
J * J + l 
INTNPtJ) = 0 
GO TO 7 

16 IFINUNST.EQ.O.GR..NOT.EF) GO TO 1 
EF « .FALSE. 

K * K ♦! 

GO TC 8 

17 IF (TENP. EQ.LP.CP.TENP.EC. RP. OR. TENP.EQ.SH. OR. TEMP. EO. AS. OR. 

♦TEMP. EG. CM) GO TO 1 

IFt INBR (TEMP). OR. TEMP. EG. DP ) . ANC.K .EQ.O ) NUMST= I 
K = K+ 1 

IF { NUMST.EG .0 ) GO TO 18 
IF(TEMP.EQ.E.CR.TEMP.EG.D) EF * .TRUE. 

GO TO 8 

18 IFIK.GT.8) GO TO 9 

NM ( 1 3 = ISLL(8,NM( t ) )+ISRLl24,NM(2) ) 

NM ( 2 ) = ISLL(8,NMI2) )+ISRL(24»TEMP) 

GO TC 8 

1 IF(NUMST.EC.O) GO TO 2 
NUMEND * NUNST+K-l 

CALL NN8R ( I NPUT , NUMST , NUM END , I ANSR , £10 ) 

IFt INTMPt J-2I.EG.BLK.AND. INTMPt J-l ) . E C . I NT . AND. INTMPt J ) .EQ.LP ) 

* GO TO 32 

IF ( INTMPt J) .NE.IP.ANQ. INTMP (J ) .N E . AS . A ND . IN TMP f J J .N E. AS 2. AND. 

* INTMP(J).N6.PL -AND • I NTMP < J ) . NE . M I . AND . I NTM P ( J ) .NE . SH. AND . INTMPt J ) 

* . NE . CM ) GC TO 34 
JaJ+l 

INTMP(J) = IANSP 

GC TO ? 

2 IFINM(2).EC*BLK) GO TO 61 

IFt INTMPt J).NE.LP.AND. I NTMP(J) . NE . AS . AND . I NTMP t J ) . NE. AS2 . AND. 

* INTMPt JI.NE.PL. AND. INT MPtJ I.NE. MI. AND. INTM P t J ) ,NE . SH. ANO. I N TMP ( J ) 

* .NE.CM) GC TO 28 

IF ITENP.EQ.LP.OR. .NOT.RESLV) GC TO 6 
CALL FNDNAMt NM.l.KGOE) 

IF( INTMPt J-2 ) .EC. BLK .AND. INTMP (J-l ) . EG . I NT . AND. 1 NTM P ( J ) . EQ. LP ) 

* GC TO 3 

GC TCI31, 26 ,23,24, 25,27), KCDE 
26 L2 = L/2+l 
J= J + l 

INTMPU) = I VALUE! L 2 ) 

GO TC 7 
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3 IFITEMP.NE. CM. AND. TEMP. NE.RP) GO TO 33 
GO TO 141,41,41,41,29,30) »KODE 

41 J = J+2 

INTMPIJ-1) = NMIU 
INTMP(J) * NMI2) 

60 TO 7 

31 CALL KSG(55,NMIl),NM{2l»NMt3) ) 

READ 101, INI 
DC 4 11=1,88 

IFUNl(Il).NE.BLK) GO TO 5 

4 CONTINUE 
GO TO 99 

5 CALL NMBR(IM,L,88,IANSR,£11) 

J=J + 1 

INTMPIJ) = IANSR 
CALL NMFCNU (NM,IANSR) 

GO TO 7 

11 CALL MSGI57»NM(1 ) , NM ( 2 ) » NM I 3 ) ) 

GO TO 31 

6 J= J+2 

INTMPIJ-1) * NM 1 1 ) 

INTMPIJ) = NMI2) 

GO TO 7 

61 IFITEMP.NE. AS. OR. INTMPI JJ.NE.AS) GO TO 62 
INTMPIJ) * AS2 

GO TO 72 

62 I F I TEMP. NE.RP. AND.TEMP.NE.AS.AND.TEMP.NE.SH.AND.TEMP.NE.pl. AND. 
♦TEMP. NE. MI .AND. TEMP. NE. CM) GO TO 63 

IF! INTMPIJ ). NE.RP) GO TO 19 
GO TO 64 

63 IFITEMP.NE.LPI GO TO 20 

IF( INTMPIJ KNE.AS2. AND. INTMP I J ) .NE- AS. AND. INTMPI J ) .NE. SH. AND. 
♦INTHPI J).NE. PL. AND. INTMPIJ) .NE. Ml. AND. INTMP (J) .NE.LP.AND. 

* INTMPI J ).NE. CM) GO TO 19 

64 IFII.EQ.IEND. AND. TEMP. NE.RP. AND. TEMP. NE.LP) GO TO 21 

7 IF! I.EQ.IEND) GO TO 12 
J = J + l 

INTMPIJ) = TEMP 
72 NM 1 1 ) = 8LK 
NM 1 2 )*BLK 
K=0 

NUMST=C 
EF = .FALSE. 

8 CONTINUE 
STOP 100 

9 CALL MSGt 56,NKtl) ,NMI2) ,NMI3) I 
GO TO 99 

10 CALL HSGI57.NMU) ,NM(2) ,NM(3) ) 

GC TO 99 

12 IFIIPRN.NE.C) GO TO 14 
J = J+l 

INTMPIJ) = PP 
DO 13 1=1, J 

13 INPUT! I ) * INTMPI I ) 
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I 


IE » J 
GO TO 100 

14 CALL MSG( 58 *NMtl)»NM( 2 l#NM( 3 ) } 

GO TO <39 

15 CALL MSGI60,NMt 1) ,NM(2) ,NMI3J» 

GO TO 99 

19 CALL M$G( 61 tIMMP(J}»TEMP»Al 
GO TO 99 

20 CALL MSG(62,TEMP,A,BJ 
GO TO 99 

21 CALL MSG ( 63 ,TEMP,A,B ) 

GO TO 99 

23 CALL HSG{S 9 f NMm,NM( 2 )tNH( 3 l) 

GO TO 99 

24 CALL MSGl 64 ,KMUi,NWt 2 ),NM( 3 H 
GO TO 99 

25 CALL HSGf 65 »NMm,NM( 2 ),NK( 3 )) 

GO TO 99 

27 CALL M$G( 132 .NMU) ,NM( 2 )»NM( 3 ) > 

GO TO 99 

28 CALL HSGU 55 tlNTPP( J),NP<l) t NM( 2 M 
GO TO 99 

29 CALL HSG 1 156.NMU) »NH(2 ),NWI3 H 
GO TO 99 

30 CALL MSG ( 157, NMt 1 ) # NM (2 > f NN{ 3 ) » 

GO TO 99 

32 CALL HSGtlSEtlANSRfAoB! 

GO TO 99 

33 CALL MSG t 159 , A, B.CJ 
GO TO 99 

34 CALL MSGI 164, INTNPf JJ ,IANSR.A) 

99 RETURN 1 

100 RETURN 

101 FORMAT ( 88 A 1 ) 

END 
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f o 


COMMND 

SUBRCUT I NE COMMND I NM, INPUT , IS , IE,* ) 

DIMENSION NM ( 1 1 » INPUT ( I ) 

COMMON /ACM0$/NAXCM0»AUXCMDt3»33),PGM(2»33) 

INTEGER AUXCMO » PGM 
INTEGER CMOS ( 66 ) / 


* 

* 


•,'DUMP* ,» 

* f 1 

*,* 

D», 

* 

i 

**' 

P* ,'RINT' ,* 

*, ' 


P* , 

* 

» 


E’»’RA$E*,' 

* »* 

* ,* 

E', 

* 

t 

* 

RES*,* TART*,* 


*,* 

R * , 

* 

• 


• , * MODE * , ' 

*, * 

*,* 

M*, 

* 

i 

*♦* 

* ,* END*,* 

** * 

*,* 

ENO', 

* 

■ 

*» * 

B* ** EGIN* , * 

*»* 

*, * 

8*, 

* 

* 

*,* 

* , * STOP * , ' 

*, * 

* »* 

S», 

* 

t 

', * 

*,* DO*,* 

*»* 


DO* , 

* 

t 


• ,’LIST*,* 

*, * 

*,* 

L* , 

* 

t 

I S' 

NTEG ' , 'RATE* , * 

f ,* 

* ,* 

I '/ 

DO 

1 1=1,66,3 







K = 1/3+1 

IFINMm.EQ.CMDSl I i . AND . NM ( 2 1 . EG. CMDS ( I + 1 ) . AND . NM ( 3 ) . EQ . 
*CMDS(I+2>) GO TO 2 

1 CONTINUE 
GO TO 14 

2 GO T0(3, 3, 4, 4, 5, 5, 6, 6, 7, 7, 8, 8, 9, 9, 10,10, 11, 11, 12, 12,13,131 ,K 

3 CALL DUMPITt INPUT , I S » I E J 
GO TO ICC 

4 CALL PRNTITI 1NPUT*IS» IE ) 

GO 10 ICC 

5 CALL ERASIT ( INPUT, IS , IE i 
GO TO 100 

6 CALL INITAL 
GO TO 100 

7 CALL MOCE IT ( INPUT, IS, IE ) 

GO TO IOC 

8 CALL ENDITI INPUT* IS, IE1 
GO TC 100 

9 CALL BEGN IT ( INPUT, IS, IE) 

GO TO 100 

10 RETURN 1 

11 CALL DO IT I INPUT, IS, IE) 

GO TO 100 

12 CALL LISTITt INPUT, IS, IE) 

GO TO IOC 

13 CALL INTGRL 
GO TC 100 

14 IF(NAXCMD-EC.O) GO TO 17 
DO 15 I *1 , NA XCND 

I I = I 

IFINMt 1 J-EQ.AUXCMDf 1, 1) - AND .NM ( 2 ) . £ Q. AU XCMD { 2 , I ) -AND.NM (3 ) - EQ, 
* AUXCMD I 3, I ) ) GO TO 16 
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IIHHUMMMMIH E 3 8 


* u 4 > t tU 


15 

16 

17 

100 

101 


CONTINUE 
GO TO 17 

CALL PGKEVU INPUT* IS » IE .PGM 1 1 * I II , 6 100 I 
GO TO 100 

CALL FGMEVL (INPUT, IS, I E ,NH ( 2 ) , E 10 1 ) 
RETURN 

CALL MSG 1 10 , NH ( 1 ) *NM (21 , NM t 3 ) ) 

GO TO 100 
END 


SUBROUTINE L 1ST IT ( l NPUT, I $, IE I 

PRINT 201 

RETURN 

201 FORMAT I* LIST NOT WORKING AT THIS TIME.') 

ENO 


SUBROUTINE DUMP IT 1 1 NPUT* IS* IE ) 

DIMENSION INPUTI 1 J ,NM{3) 

COMMON /FCTS/NFCT,LSTI »IUSFCTi 1000) 

CCMMCN/NAMES/NMLT, NAME! 100 ), VALUE (50 ) 

COMMON /PROCDS/NFCO»LASTI f ICNT * IUSPCD l 2000 ) 

COMMON /MCCEI/DEBUGfPROCED 

LOGICAL DEBUG, PRCCEO 

INTEGER BLK»TEMP,RP 

INTEGER CMP { 24 ) / 

* * * , * VA* * * L UES 1 , * * t * 

* ' L SRF * , * UNC T ' » * IONS* , * *,* 

* * SYSF '» *UNCT» ,• IONS' , * 

* * PR* ,'OCED* , * URES * » ' *,» 

DATA B L K ,R P / * *,')*/ 

IFfPROCEC) GC TO 10 

IFUS-EG-O) GO TO 10 

N1 = IS+1 

NM(l) = BLK 

NM(2> = BLK 

NM 1 3 ) = BLK 

K * 0 

DO 11 I = M » IE 
TEMP = I NPUT ( I ) 


IF 

ITEMP* 

.EQ.E 

LK) 

GO 

TO 

11 



IF 

(TFMP* 

>t£3 . R 

P) 

GO 

TO 

12 



K 

= K + l 








IF 

f K*GT*12 1 

GC 

TO 

20 




NM 

m = 

ISLL 

(8, 

NM( l 

n + 

ISRL 

( 24 1 

i NM (2)1 

m 

(2) = 

ISLL 

(8, 

NM { 2 

) J4 

ISRL 

12 A, 

r NM ( 3 ) ) 

HM 

(3) * 

I Sit 

18, 

N M { 3 

) H 

ISRL 

{ 24 i 

.TEMPI 


V’ , 
UF* , 
SF* , 
P'/ 


LISTIT 


DUMPIT 
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mmm\ 


11 CONTINUE 

CALL MSG !82 , A, 8, C J 
GO TO 100 

12 IFIK.EC.C) GO TO 19 
00 13 1*1,24,3 

K * 1/3+1 

IF INN <1 l.EQ.DMPI 1 ).ANC.NM( 2)-EC.DMP! 1+1 l.AND.NM! 3) .EQ.DMP! 1+2) J 

* GO TO 14 

13 CONTINUE 

CALL MSG(83,NM(1) ,NM!2),NM!3) ) 

GO TO 100 

14 GO TOI 15,15,16, 16,17,17,18,16) »K 

15 IFINNLT.EQ.C) GO TO 3 
CALL NSG (32 , A, B, C ) 

N 1 = 1 

N2 = 8* INNLT/8 ) 

IFIN2.EC.0) GO TO 22 
00 21 I = Nl ,N2» 8 
J = 1/2+1 

21 PRINT 202, NANE(I), NANElI + l) .VALUE U J , NAME C 1 + 2 I , NAME! I+3J, 

♦ VALUE! J + i >, NAME! 1+4 ),NAME I I +5 ) , VALUE ! J + 2 ) .NAME U+6) ,NAME( 1+7) , 
♦VALUE! J+3) 

IFIN2.EC.NNLT) GO TO 100 

22 N1 * N2+1 

N3 * 6*i (NNLT-N2)/6)+N2 
IF ( N3 .EG.N2 ) GO TO 24 
N2 = N3 

DO 23 I*M,N2,6 
J * 1/2+1 

23 PRINT 202,NANEI I), NAME! 1+1 >, VALUE !J ), NANE ( I +2 ), NAME U + 3 > , 

♦ VALUE! J+U , NAPE! 1+4) , NAPE (I +5 >, VALUE l J+2 ) 

IFIN2.EC.NMLT ) GO TO ICO 

24 N 1 = N2+1 

N3 = 4M !NMLT~N2)/4)+N2 
If!N3.EC.N2> GO TO 2 
N2 * N3 

DO l I*M,N2,4 
J= 1/2+1 

1 PRINT 202,NAPEI I) , NANE! 1+1 ) ,VALUE(J), NAPE! 1+2), NAME! 1+3), 

* VALUE! J+l) 

IFIN2.EC.NNLT) GC TO ICC 

2 J * KNLT/2 

PRINT 202, NAME INMLT-l ), NAME ( NPLT > .VALUE ( J) 

60 TO 100 

3 CALL MSG 133 , A ,B ,C ) 

GO TO 10G 

16 IF(NFCT.EC.O) GO TO 6 
CALL MSG ( 35 ,A ,B,C ) 

J * 1 

DC 5 I*i,NFCT 

NARG * IUSFCT! J+3J/2 

PRINT 20?,IUSFCTIJ), IUSFCT! J+ l ),NARG 
J * IUSFCT ( J+2 ) 

5 CONTINUE 


42 



GO TO 10U 

6 CALL MSG(34,A,B,C) 

GC TO IOC 

17 CALL PGM ST 
GO TO 100 

18 IF(NPCD.EQ.C) GC TO 9 
CALL MSG{17,A,8,C) 

J * l 

CO 8 l*l,NPCO 

PRINT 207, ILSPCDIJJ ,IUSPCD( J+U 
J = I US PCD! J +2 1 

8 CONTINUE 
GO TO ICO 

9 CALL MSG <39, A, 8,0 
GO TO 100 

10 CALL MSGIA0,A,8,C) 

GO TC 100 

19 CALL MSG(8A,A, B,C) 

GO TO ICO 

20 CALL MSG (85, A, B»C 1 
100 RETURN 

202 FORMAT ( A ( 2X ,2A4 , * = * ,G 14.6 1) 

207 FORMAT {» * ,2AA ,5X, 13, • ARGUMENTS.*) 
END 


PGMNAM, PGMLST 

C SU8R0UT INE TO MATCH INPUT NAME WITH FUNCTION NAME 

SUBROUTINE PGMNAM I PGM I , IFN ) 

INTEGER PGMI(l) 

DATA N PGM / 38 / 

INTEGER PGM < 38 ) 

OATA PGM/ 



i 

* , 0 EXP' , * 

fl * f LN • * • 

ICG*,* 

AR', *CSIN' , 

♦ 

< 

AR' , 'CCCS* , * 

Aft 1 * * CT AN f f 1 

’** SINN’ 

COS', 

4 

t 

',' TAN*,' 

* T * SQR T f t * 

N’TANH* ** 

♦ , • SINH' , 

* 

t 

'•'COSH',' 

1 * ■ mf • , * 

* , # F RFC * v * 

G' , ' AMMA* , 

* 

• 

L NG ' ,' AMMA* , • 

* , * A BS # * 1 

I NT ’ / 


6 

DO 

7 IFN=1,NPGM,2 





IFNI = IFN 

IF (PGMI III. EC. PGM! IFN). AND. PGMI 12) .EQ.PCMI IFN + 1 ) ) GO TO 8 


7 CONTINUE 
IFN = 0 
GC TC ICO 

8 IFN = IFN 1/2 + 1 
GC TC 100 
ENTRY PGMLST 
PRINT 2C1 
PRINT 202 
PRINT 203 

100 RETURN 

201 FORMAT I* LIST CF AVAIA6LE FUNCTIONS.',/, 

*' NAME DEFINITION ARGUMENT RANGE') 
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202 FORMAT t 


+ ' 

EXP 

EXPONENTIAL 

X<174.673 * , /, 

** 

IN 

NATURAL LOGARITHM 

X>0 * , /, 

*» 

LOG 

COMMON LOGARITHM 

X>0*,/, 

* t 

SIN 

SINE 

! X }< (2**18)*P I *,/, 

*• 

COS 

COSINE 

J X|<(2**18)*PI* ,/, 

** 

TAN 

TANGENT 

I X | < 1 2** 18) *P I * , / , 

** 

ARCSIN 

ARCSINE 

IXK1S/, 

* * 

ARCCCS 

ARCCOSINE 

|x|<i*,/. 

** 

ARCTAN 

ARCTANGENT 

NO RESTRICTION* ) 

FGftMAI 

t 



** 

SINH 

HYPEP8CL IC SINE 

X<174. 673* , / , 

*1 

COSH 

HYPERBOLIC COSINE 

X<174.673*, /, 

* « 

TANH 

HYPERBOLIC TANGENT 

NO RESTRICTION',/, 

#« 

SORT 

SQUARE ROOT 

X>=0*,/, 

** 

ERF 

ERROR FUNCTION 

NO RESTRICTION*,/, 

* » 

ERFC 

COMPLEMENTED 

NO RESTRICTION* ,/, 

** 


ERROR FUNCTION*,/* 



GAMMA 

GAMMA FUNCTION 

2** 1—252 )<X<57.574 * ,/ 

* * 

LNGAMMA 

NATURAL LOGARITHM 

0<X<4.29I3E+73* ,/, 

* 1 


OF GAMMA FUNCTION*,/* 


* * 

ABS 

ABSOLUTE VALUE 

NO RESTRICTION*,/, 

** 

INT 

INTEGRATION 

NO RESTRICTION',/, 

** 


3 ARGUMENTS* ,/, 


** 


(USR FUNCTION, LIMIT, LIMIT) * ) 


END 


PRNTIT, PRNT 

SUBROUTINE PRNT I T II NPUT , I S , I E I 
DIMENSION INPUT<1)»NM(2) 

CCMKCN/NAK£S/NMLT»NAME(lGO) .VALUE (50) 

COMMON /PROCCS/NPCO,LASTI, ICNT , IUSPCD (2000 ) 

COMMON AM 0DE1/CEBUG, PEGGED 
LOGICAL DEBUG, PRCCED 
INTEGER ELK , CM , TEMP 
DATA BLK,CM/< *,','/ 

Nl = IS+I 
N3 = IE-1 

IF(N3.LT.M> GO TO 101 
I = 0 

1 NMD = ELK 
NM ( 2 ) - BIK 
K = 0 
N2 * Nl 
00 2 J=N2,N3 
Nl = M + l 


7 E 

ftp = 

INPUT (J) 


IF 

1 TF*P 

• EG 

• ELK ) 

GO TO 2 

IF 

tTEHP 

• EG 

.CM) 

GO TO 3 

K 

- K + l 




IF 

<K*€T 

.8 ) 

GO 

TO 2 
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NNIU = ISLLC8,NHCL) ) + 1 SRL I 24 tNK ( 2 ) ) 
mill = ISLL(8*NMX2) ) + 1 SRL C 24 * TEMP ) 

2 CONTINUE 

3 I F ( K* EQ *0 ) GO TO 52 
I F C K*GT . 8 ) GO TO 51 

I F ( l • EG • 1 8 ) GO TO 53 
I - 1 + 1 

INPUT III * Mmi 
X = 1 + 1 

INPUT m = NM21 
GO TO 4 

51 CALL KSG(24,NNI U v NHf2l« A J 
GO TO 4 

52 CALL M5G< 124* A*8,CI 

4 IF ( N1 .L E * N3 ) GO TO 1 
GO TO 5 

53 CALL MSG J 12 5 * A * 6 *C ) 

5 IF ( I .EC *0 ) GO TO 101 
IF f PROC ED ) GO TC 70 
N 1 - l 

N2 = I 
GO TC 6 

ENTRY PR NT I INPUT * I S * 1 E ) 

N 1 = IS 
N2 = IE 

6 II = N 1 

7 IFC IX.GT.N2) GO TO 100 

CALL FNDNAMt INPUT (ID * INDEX *KGDE) 

go tc i e*9«dffl*s,e ) *kgoe 
e ii = ii+2 

GO TC 7 

9 Jt = INDEX/2+1 
12 = 1 1*2 

10 IF? I2*GT.N2 } GO TO 17 

CALL FKDMME INPUT U 2 ) * I NCEX * KCOE ) 

GOTO tllfl2tU«ll»Litin v K00E 

11 12 - 12+2 
GO TC 10 

12 J 2 = INDEX/2 + 1 

13 = 12+2 

13 IFi 1 3 *GT * N2 1 GO TO 16 

CALL FNDNAHE INPUT (13) » I NCEX * KGDE ) 

GO TO i 14*15*14* 14* 14* 14)* KODE 

14 13 = 13+2 
GO TO 13 

15 J3 = I NOEX/2+1 

14 = 13+2 

151 I F I 14 *67 *N2 I GO TO 154 

CALL FN0NAMUNPUTU41* INDEX *KODE) 

GO TO I 152*153*152* 152*152*152) tKOOE 

152 14 = 14+2 
GO TC 151 

153 J4 * INDEX /2+I 

PRINT 202 t INPUT { 111 , INPUT I 1 1+ 1) , VALUE { J 11 * I NPUT E I 2 ) * I NPUT ( 1 2+U * 


I u 


♦VALUE { 32) * INPUT (131, INPUT U3 + I 1 , VALUE tJ3) , INPUT 1 14 ) * INPUT ( |4 + U, 
LVALUE l J4 ) 

NX = 14+2 
GO TO 6 

154 PRINT 202 * INPUT < III , INPUT ( 1 1* 1 J , VALUE I J 1 J , I NPUT U 2 ) * I NPUT 1 1 2+ 1) * 
* VALUE t J2 > * I h PUT I 13 ) t I NPUT 1 13+11 * VALUE ( J 3 > 

GO TO 100 

16 PRINT 202 » INPUT (III# INPUT II 1 + 1 I f VALUE i JU t INPUT ( 121 » INPUT ( 12+11 t 
♦VALUE ( J2 ) 

GO TC ICC 

17 PRINT 202 * INPUT {111* INPUT { Il + IJtVALUECJl) 

GO TO ICO 

70 IF(LASTI+I+2*GT.1996) 60 TC 72 

IUSPCOUCNT) * IUSPC0UCNTI+I 
LASTI = LASTi+1 

IUSPCO I LAST 1 ) = I 
LASTI = LAST I + i 
lUSPCDf LASTI 1 * 4 
DC 71 J=l t I 
LASTI = LAST I + 1 

71 lUSPCDI LASTI > = INPUTIJl 
GO TO 100 

72 PROCED * .FALSE* 

LAST! = ICNT-4 
NPCD » tSPCO-1 

CALI HSGfllCt IUSPCDI LASTI+1 1 * I USPCD IL AST I +2 ) * A J 
GO TO ICC 

101 CALL NSG ( 123 » A * B* C 1 
ICC RETURN 

20 2 FORMAT (4 ( f * « 2 A4* ■ = • , G 14 . 6 }} 

END 


BEGNIT 

SUBROUTINE B EGN I T ( I NPUT, I S » I E ) 

01 PENSION I N PUT (1)*NH(2! 

COP RON /PROCOS/NPCD, LAST I fICNTtIUSPCD (20001 

CCMNON /NODE 1/DE BUG # PRGCEO 

LOGICAL OEELGf PRCCED 

INTEGER BLK *TENP 

DATA BLK /* */ 

I F { PROCED } GO TC 101 

IF £ IS.EQ.C ) GO TO 102 

N 1 = IS + 1 

N2 = IE“1 

NN(U = BLK 

NN(2) = BLK 

K = C 

DO 1 I = N 1 1 N 2 
TEMP - INPUT U) 

IFfTENP.EQ.EltO GO TG l 
K a K + l 
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n * 


IF4K.GT.ei GO TO 103 

NH11) * lSLL18,NMtl) > + ISRL124fNN<2n 

NM(2) = ISLU8,NM(2) > + ISRL( 24, TEMPI 

1 CONTINUE 

IFtK.EQ.OI GO TO 102 

CALL FNDNAM INM, I ,KOCEJ 

GO TO !2,1C5, 106*107, 108, 109) »KCDE 

2 PROCED = .TRUE. 

NPCD * NPCD+1 
LA ST I « L AST 1 + 4 
IUSPCC4LASTI-3 1 * NMUJ 
IUSPCC1LASTI-2) a NM42I 
ICNT = LASTI 

IUSPCOI I CNT I * l 
GO TO 100 

101 CALL MSG (87, A»B*C) 

GO TO 100 

102 CALL M$GI88,A,B,C) 

GO TO 100 

103 CALL NSG124*NK( 1 ) * NM t 2 ) , A I 
GO TO ICO 

105 CALL MSGI 89.NMI 1 ) ,NN 12 ) , A 1 
GO TC 100 

106 CALL MSG(90,NMl),NM(2) f A) 

GO TO ICC 

107 CALL MSG19 1 ,NN 1 I ) ,NN (2), A) 

GO TC 100 

108 CALL MSG 492,NM 41) ,NH (2 > , A ( 

GO TC 100 

109 CALL MSG( 13C»NM(l)iNM(2)*A> 

ICO RETURN 

ENO 


ENDIT 

SUBROUTINE E ND I T 4 1 NP UT , I S , I E > 

DIMENSION INPUT 41 1 » INTMP 1441 ) 

COMMON /PRGCCS/NPCD.LASTI »ICNT, IUSPCD1 20001 

CCMMCN /MGDEl/DEEUG.PROCED 

LOGICAL DEBUG, PROCED 

INTEGER GTtElK 

DATA GT,LT,ELK/*>*,*<* f * V 

IF1PRCCECI GO TO 1 

CALL MSG (93, A ,B,C I 

RETURN 

1 PROCED * -FALSE. 

I F ( I5.NE.0 ) GO TO 3 

2 IUSPCCC ICNT-1J = LASTI+1 
RETURN 

3 N1 = IS+1 
N2 a IE-1 
K a 0 
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3 REL = 0 

LS = LAST I 

DO 4 I=N1,N2 

INTMPI I ) = INPUTUI 

IF! INPUT! I l.EQ.BLSO GO 70 4 

X * K + l 

IF{ INPUT! IUNE.LT.ANO.INPUT (I J.NE.GT) GO TO 4 
IREL = I 

4 CONTINUE 

IF I IREL.NE.O ) GO TO 7 
ZFIK.NE.C) GC TC 5 
CALL MSG 194, A,S»C) 

GO TO 2 

5 CALL MSG I95*A,B,C) 

6 PRCCEO = .TRUE. 

RETURN 

7 1ST = IS+L 
IND = I R EL— 1 

I F ( IST.LE. INC) GO TO 71 
CALL M SG 1 96 , A » B ,C ) 

GC TO 6 

71 CALL PRESS2f INPUT, 1ST, INC, E8> 

GO TO 9 

fl CALL MSG 147, A. 8,0 
GO TO 6 

9 IF{LA$TI+1+IND.GT„1996> GC TC 14 
LASTI = LASTI+1 
I US PCD ( L A ST ! ) * IND 
DC 10 1=1, IND 
LASTI = L AST 1 + 1 

10 ItJSPCD(LASTI) = INPUT ( I ! 

LASTI = LASTI+1 

IU SPCC I L A ST I 1 = INTMPI IRELt 
1ST = IREL+1 
IND = IE-1 

IF ( IST.LE.INC) GC TO 101 
CALL MSGt98,A,B,C) 

LASTI = LS 
GO TC 6 

101 CALL PRESSZUNTMP, 1ST, IND, fill) 

GO TO 12 

11 LASTI = LS 
GO TO 8 

12 IF (LASTI+IND.GT. 1996) GO TO 14 
DO 13 1=1, INC 

LASTI = LASTI+1 

13 I USPC D t L A 5 T I ) = INTMPI I) 

GO TO 2 

14 LAST! = I CM— 4 
NPCD = N PCD- I 

CALL MSGI1 10, IUSPCCI LASTI+1 ), IUSPCD ( LAST I +2 ) , A) 

RETURN 

END 
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c 


ERASIT 


SUBROUTINE ERASIT U NPUT , I OPTST , I CPTND 1 
0 1 MENS ION INPUT fit* NMI2) 

COMMON /NAMES/NMLT,NAHE(1001,VALUEI50) 

COMMON /FCTS/NFCT.LSTI, IUSFCT( 1000 1 

COMMON /PROCOS/NPCDfiAST It IC NT *IUS PC 0(20001 

COMMON /MODEl/DEBUG.PROCEO 

LOGICAL CEfiUGtPROCEO 

INTEGER CM,ELKtRP»TEMP,SWT 

DATA CM,BLK,LP,RP/' »*» ' 

IF (PRCCECl GO TO 14 

IF( I0PTST.EC.O GO TO 13 

IF( NMLT*NFCT+NPCC.EQ.O» GO TO 12 

SWT=1 

K=0 

NMI 1 ) = BLK 

NM ( 2 1 =B LK 

N 1 = IOPTST+1 

DO 10 1= N1 f IOPTNO 

TEMP* INPUTU1 

IFITEMP-EQ.BLK1 GO TC 10 

IF (TEMP. EQ. CM. OR. TEMP. EG. RP ) GO TO (3,7)»SWT 
K = K+1 

IFIK.EQ.9) 5 V T = 2 
IF(K.GT.B) GO TO 10 

NMS1J * ISLUBfNMU 1 ) + 1 SRL 1 24 . NM ( 2 > ) 

NM ( 2 1 = ISLL(8,NM(21 ) + I SRU 24 , TEMP ) 

GO TC 10 

3 IF(NMm.EQ.8LK.AND.NM(2).EQ.BLKl GO TO fl 
CALL FNONAM(NM, J t KOCE» 

GO TO (73*31 *5,71 ,75,76 1 ,KODE 
3 i J2 * J/2+l 

IF[ J.EQ.NMLT 1 GO TO 41 
DC 4 K=J f NMLT,2 
NAME ( K 1 = N AME { K +2 ) 

NAME(K+1) = NAME ( K+3 1 
K2 = K/2+1 

4 VALUE ( K2 1 * VALUE ( K2 + 1 } 

41 NMLT = NMLT-2 

GO TO 72 

5 J = J-I 

K * IUSFCT { J +3 1— 1 

IF ( K.EQ.LSTI ) GO TO 61 

L « K-J 

LL a LSTI-L-J 

N » IUSFCT ( K+31+2 

IUSFCTIK+31 * IUSFCTtK+3 J-L 

00 6 M*1,LL 

J a J+l 

K * K + l 

IF1K.NE.M GO TO 6 


N * IUSFCTIKI+2 
IUSFCTI K } * IUSFCT ( K 5—L 

6 IUSFCT I J I * IUSFCT I K > 

61 LST I » J 

NFCT * NFCT-l 
GO TO 72 

71 J - J-l 

K * IUSPCD I J*3 1-1 

IF ( K-EG. LASTI ) GO TO 8t 

L * K-J 

U = LAST I-L-J 

N « IUSPCOI K+BJ+2 

IUSPCO l K + 3 1 a I USPCD IK+3 J-L 

DO 15 K*l»Ll 

J * J + l 

K = K+l 

IFIK.NE.N) GO TO 15 
N « IUSPCD l K 1+2 
IUSPCOI K 1 = IUSPCOI K )-L 
15 IUSPCOI JJ = ILSPCOIK) 

81 LASTI * J 

NPCO » NPCD-1 

72 IFINPLT+NFCT+NPCD.EQ.O) GO TG 11 
GO TO 7$ 

73 CALL WSGI23*NMI1)»NMI2)»NMI3)I 
GO TO 74 

7 CALL NSGI24,NM 1) ,NM!2! tNK(3H 
GO TO 74 

8 CALL MSG«25,NPm ,NPI2»,K«(3n 
GO TO 74 

75 CALL NSGI31»NPI l > ,NP (2 ), NM 1 3 ) I 
GO TC 74 

76 CALL PSGI135*NMtl>,NMl2),NMI3>J 

74 NH(U = BLK 
NH ( 2 } =8LK 
5WT= l 
K=0 

9 IFITEPP.EC.RPJ RETURN 

10 CONTINUE 

CALL PSGI26,M»Il)»NH(2),NMI3n 
GC TO IOC 

11 CALL MSG(27,NfMl> ,NM12) 

GO TO 100 

12 CALL NSG(28,NNl 1I.NPI2) ,NMI3> J 
60 TC ICO 

13 CALL PSGI29»NHH)*NMI2)»NM<3)) 

GO TC IOC 

14 CALL NSGI30,NMm # NM(2),NM(3>) 

100 RETURN 

END 
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c 


MODEIT 


SUBROUTINE NCDEIT! INPUT , IOPTST. IOPTND ) 

DIMENSION INPUT ( l ) »NM ( 3 1 
COMMON /MCDE1/CEEUG.PRGCE0 
LOGICAL DEBUG i PROCED 
INTEGER BLK .TEMP.RP 
DATA BLK .RP/ ’ *,')»/ 

INTEGER MO0( 18 } / 

* • *,* O'.'EBUG'.' *t* '»* D*. 

* * «,» N * . * CBUG* i * *»' '»• N', 

* * *,* RE * » ' AL*4* f * R*A'/ 

IFIPROCEC) GC TO B 

IFf IOPTST. EC. 0) GO TO 7 

N 1 a IOPTST+1 

NM ( n*BLK 

NM(2)*BLK 

NM{ 3 }=BLK 

K=0 

DC 1 I = M* I CPTND 
TEMP* INPUT II) 

IF (TEMP. EC. ELK ( GO TO 1 
IF ( TEMP.EQ.PP) GO TO 2 
K= K + l 

IFfK.GT.12) GC TC 6 

NM(U = ISLLIB.NMm )+ISRL(24,NN(2 H 
N M ( 2 ) * ISLL (8.NMI2) > + ISRL( 2A,NM(3n 
NM(3) = 1 SLL IB.NH (3 )) + ISRL(24 .TEMP) 

1 CONTINUE 

CALL MSG ( I3,NMm.NM<2 },NM( 3) ) 

GC TC ICO 

2 IF(K.EQ.C) GC TO 7 
DO 21 1 = 1. IB, 3 

K * 1/3+1 

IF INM( 1 J.EQ.MCDU ). AND.NM ( 2 ) . EQ.MODI I +1 ) . AND.NM ( 3 ) . EQ.MOD I I+2J ) 

* GO TO 22 

21 CONTINUE 

CALL MSG( 14. NM I 1).NM(2).NM13J ) 

GC TO 100 

22 GO TQ(3.3.4f4.5.5)tK 

3 IF t DEBUG ) CALL MSG( 15 .NM (1) , NM ( 2 ) ,NM (3 M 
IF(„ NOT. DEBUG! CALL MSG (16 , NM U > , NM ( 2 ) , NM ( 3 )) 

DEBUG* .TRUE. 

GO TC 100 

A IF ( DEBUG ) CALL MSG 1 17 , NM (1J . NM { 2 ) , NM ( 3 ) ) 

IF(. NOT. DEBUG) CALL MSGUB .NM ( 1 1 .NM (2 ) . NM ( 3) > 

DEBUG =. FALSE. 

GO TO IOC 

5 CALL MSGt 19 »NM( 1 ) .NM (2 ) .NM { 3) ) 

GO TO 100 

6 CALL MSG(20.NMtl ).NK(2>.NM{3) ) 

GO TO 100 

7 CALL MSG(2l.NMtl),NK(2),NMO)) 

GO TO ICO 

8 CALL MSG (22,NM(1) ,NMI2> »NM( 31 ) 

ICO RETURN 

END 
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I 


i 


i i i in 1 1 ii mu 


DOIT 

SUBROUTINE tOITt INPUT,IS,IE ) 

DIMENSION I N PUT 1 1 } » NM f 2 ) 

COMMON / PRO CDS/NPCO, LAST 1 , 1CNT. IUSPCD ( 2000) 

COMMON /MCDEl/DEBUGfPROCEO 
LOGICAL DEBUG, PROCED.ASC 
INTEGER BLK.AS.TEMP.TYPE 
DATA BLKrAS.LT/* »,***,*<•/ 

IF t PROCEC ) GO TO 101 
IF(IS.EC.O) GO TO 102 
N 1 = IS+1 
HZ = IE-1 
NM t 1 } = ELK 
NM 12 ) = 8LK 
K = 0 

ASC = -TRUE. 

DO 1 I=N1,N2 
TEMP * INPUT U ) 

IAS * I 

IF! TEKP.EC.BLK ) GO TO 1 
IF (TEMP .EC. AS ) GO TO 2 
K = K + l 

IF ( K.GT *8 ) GO TO 103 

NMUJ - ISLU8,NMm )+ISRL(24,NM(2) ) 

NM(2) * ISLL i 8 » NM t 2 ) J + ISRL (24 .TEMP) 

1 CONTINUE 

IFSK.EQ.OI GC TC 104 
ASO * .FALSE. 

2 CALL FNONAM (NM, INDEX. KOOE ) 

GC TO(106.107»108r3,I09,U4),KGDE 

3 IF(ASQ) GC TO 31 
1TIMES * 1 

GO TC 32 

31 NUMST = IAS-U 
NUMND = IE-1 

call NMBRt INPUT, NUMST,NUMND,ANS,GIOO) 

HIRES = AN S 

IFt HIMES. L£.O.CR„!TIMES.GT. 50) GO TO 110 

32 LAST * ILSPCDt INOEX+2)— 1 
NMBRST = IUSPCDI INOEXO) 

INDEX = INCEX+4 

DC 11 LOOP= 1 » I T I ME S 
IOX = INDEX 
DO 8 1ST M T= 1 » NMBRST 
LENGTH = IUSPCOUDX) 

IFUSTMT. EC. NMBRST) GO TO 9 
TYPE = lUSPCCf IOX + H 
GO T0t4, 5, 6,7.71 ) . TYPE 
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4 1ST = 10X44 

IND = IST+LENGTH-3 

CALL RESLVl ( 1USPC0, I ST, I NO » INPUT , £1 1 1) 
1ST * l 

CALL EVALU INPUT ,IST,IND,ANS«£111) 

CALL NMECNUtlUSPCOt IDX42UANS) 

GO TC 8 

5 CALL NMECCSUUSPCOUDX+2) ) 

GO TO a 

6 1ST * IDX+2 

IND * IST4LENGTH-1 

CALL RESLV1 ( IUSPC0,IST, IND, INPUT, SUL) 
1ST =» 1 

CALL EVALK I NPUT , 1 ST , I N D , AN S , S U U 
CALL MSG(78,ANS,A,8) 

GO TO 8 

7 1ST * 10X42 

IND * IST4LENGTH-1 

CALL PRNTULSPCD,1ST,INC> 

GO TO 8 

71 1ST = IDX+2 

IND = IST4LENG7H-L 

CALL RESLVl ( IUSPCC, I ST , I ND , 1 N PUT » SI 1 U 
1ST * 1 

CALL EVALU INPUT , 1ST ,IND,ANS,S 111 ) 

8 IDX * IDX4LENGTH+2 

9 IFfIDX.GE.LAST) GO TC 11 

1ST * 10X41 

1 NO = JST4 IUS PCD IIDX )- 1 
IREL = IND41 

CALL RESLVl (IUSPCD, 1ST, IND, INPUT, SI 11) 
1ST * l 

CALL EVAL1I I N PU T , I ST , I NC , ANSI * £ 11 U 
1ST = IREL+1 
IND a LAST 

CALL RESLVU IUSPCD, I ST , I NO ,! NPUT , S 111 ) 
1ST = 1 

CALL EVAL1 (INPUT, 1ST , I NC t ANS2 , S 1 11) 
IFUUSPCO(IREL)-EQ.LT) GO TO 10 
IFfANSl.GT.ANS2) GC TO 112 
GO TC 11 

10 IFfANSl.LT.ANS2) GO TO 112 

11 CONTINUE 
GO TC 113 

101 CALL MSC!99,A,B,Ci 
GO TO 100 

102 CALL MSG t IOC , A , B ,C) 

GO TC 100 

103 CALL MSGl24,Nm),NM(2)„A) 

GO TC ICC 

104 CALL MSG ( 101 , A, 8,0 
GO TO ICO 

105 CALL M SG f 102 * A , B ,C ) 

GO TC 100 


106 IF(.NCT.ASQ) GC TO 105 
CALL MSG(4t,NMm*NM(2)»A) 

GO TC ICO 

107 CALL MSG(103.NM(1)*NM(2) *A> 

GO TO 100 

1C8 CALL M5G(42,NN(1)*NN(2),A) 

GO TO IOC 

109 CALL M$G(44,NM(1 },N«I2J*A) 

GO TC 100 

110 CALL MSG f 104»ITIMES*A I 8) 

GC TC 100 

111 CALL M$G(105»ISTMT»NM(l)*NM 12) ) 

GO TO ICC 

112 CALL MSG(106,ANS1, lUSPCDUREL )» ANS2> 
GO TC IOC 

113 CALL MSG(1C7,ITIMES*A»B> 

GO TC 100 

114 CALL MSG I 133»NMtl)*NMI2)*A) 

100 RETURN 

END 


PGA/1EVL 

SUBR0U7 INE PGME V L ( I NPliT , I LP * I E NO,NM ,* ) 

DIMENSION NM ( 1 ) * INPUT (11 

COMMON /PRCCOS/NPCD»LASTI»ICNT» IUS PCD 12000) 

COMMON /MODE 1/ DEBUG* PROCED 
INTEGER R P » B LK 
LCGICAL CEEUG,PRGCED 
DATA LP*RP»BLK/’ I * » * i * » * '/ 

CALL LOACEOINM.KCDE) 

GC TO (3*1) *KCDE 

1 CALL LOAD ! NM *KOCE) 

GO TO I 2 » 20C ) » XODE 

2 CALL MSG(129,NM(l)*NM(2)*A) 

3 IEtPROCED) GC TO 6 
IE( ILP.EC-.0) GO TO 4 
1ST = 1 

I END = I END— I LP + 1 

CALL PRESS li INPUT { I LP ) » 1ST* IE NO* £ 100 i 

I END = I L P + 1 END-2 

1ST * ILP-1 

INPUTIIST) = NMUJ 

I NPUT ( I ST* I ) = NM ( 2 l 

GD TC 5 

4 1ST = 1 

I END = 5 

I N PUT 1 1 ) = NM ( l ) 

I NPUT (2 ) = NM(2i 
INPUT ( 3 ) = LP 
I N PUT ( 4 ) = 8LK 
INPUT (5) = PP 

5 CALL EVALM INPUT ( 1ST )*IST*IEN0*ANS*£100) 
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GO TO ICO 

6 I F ( ILP. EC.O ) GO TO 7 
1ST * 1 

I END * IEND-lLP+1 

CALL PRESS2! INPUT (UP) , 1ST, IEN0,£iOOl 

IE NO = I LP+ I END-2 

1ST = ILP-I 

INPUT (1ST! * NM ( 1 ) 

INPUT ( I ST+1 ) « N N ( 2 ) 

GO TO 8 

7 1ST *■ 1 

I END = 5 

INPUT ( 1 1 = NMI1J 
INPUT (2 1 = NN ( 2 I 
INPUTI3J * LP 
INPUT14) = ELK 
INPUT (5 ) = HP 

8 IF ( LASTI + UFND-IST+1 H2.GT.1996) GO TO 10 
IUSPCD! ICNT ) = IUSPCD ( ICNT )+l 

LASTI a LASTI+1 

IUSPCOUASTI ) * I END- 1 ST * l 

LASTI = LAST 1 + 1 

IUSPCD ( LAST I ) = 5 

DC 9 I=I5T* IEND 

LAST! = LASTI+I 

9 I U SPCD ! L AST I ) a INPUT ( I > 

GO TC LOO 

10 PROCEO * .FALSE. 

LASTI = 1CNT-4 
NPCO = NPCO-1 

CALL PSG(110,IUSPC0(LASTI + n,IUSPCD(LASTI+2),At 
ICO RETURN 
2C0 RETURN 1 
END 


USRPGM 

SUBROUTINE USRPGN (INPUT ,N1 ,N2, ILP, ANS,*J 
INTEGER INPUT { t J , ARG l 1 0 > , ANS , BL K , CN 
DATA ELK, CM/' 

NARG = C 

IF(N1.GT.N2) GO TO LC 
DO 1 I = M , N2 

IF( INPUT ( I ) .EQ.8LK. OR. INPUT (I ) . EQ. CM ) GOTO I 

NARG = NARG+1 

IF ( NARG.GT. 10 ) GO TO 3 

ARGINARG1 = INPUT ( 1 1 

1 CONTINUE 

10 CALL RUMTl INPUT l ILP-2), NARG, ARG. ANS.KOOE) 

GO TO (2,4) , KCOE 

2 RETURN 

3 CALL NSGI137, INPUT! ILP-2) » INPUT ULP-l ), A! 

GO TO 5 

4 CALL RSGU38.INPUTULP-2), INPUT! ILP-t»,AJ 

5 RETURN 1 
END 



c 


RESLVl, RESLV2 


SUBROUT IKE RESLVl ( IN, IS, IE.GUT,*) 

COMMON /MKES/NMLT, NAME 1100 ),1VALUE(50) 

INTEGER GUT ( 1 ) 

DIMENSION IM1I,INK88) 

INTEGER ARG, TEMPI, TEMP, A $,AS2»$F,PL,RP,BLK»CM 
DATA INT/* INT 1 / 

DATA BLK.CM/* »,*,*/ 

DATA AS, AS2,SH, PL, MI,RP,LP/* **,**•• , */','+* ,*-»,•)*,* t ' / 

KALL * i 

GO TC 1 

ENTRY RESLV2UN,IS,IE,DUT,NARG,NM,ARG,*) 

DIMENSION NM (l),ARG( l» 

KALI * 2 
1 JJ » 0 

CO 8 1= IS, IE 
TEMP * IN Hi 

IFITEMP.NE-AS.AND.TEMP.NE. A S2. AND.TEMP.NE.SH.AND.TEMP.NE.PL. AND. 
•TEMP.NE. MI. AND. TEMP. NE.RP. AND. TEMP. NE.CM ) GO TO 6 
IP I I-2.LT.ISI GO TO 6 
IFUNU-U.EC.RP) GO TO 6 
TEMPI * IM 1-2) 

IF (TEMP 1. EQ. AS. OR. TEMPI .EQ.AS2.0R. TEMPI. EQ.SH.0R.TEMP1.EQ.pl. OR. 

• TEMPI. EQ. MI .OR. TEMPI. EQ.RP. OR. TEMPI. EC. LP. OR. TEMPI. EQ. CM) GO I*n 6 
1FIRALL.EQ.1) GO TO 21 

DO 1C 1 1- 1, NARG,2 
13 * UIUI/2 

IFUNII-2). EQ.NMU I). AND. INU-1 ).EQ.NMf II + IH GO TO 1A 
10 CONTINUE 
GO TC 21 
1 A JJ = JJ-1 

CUTUJ) = ARG ( 13 ) 

GO TC 6 

21 CALL FNDNAM1 INU-2) ,L,KCDE) 

IF (OUT! JJ-AJ.EQ.8LK. AND. CUT! JJ-3 ) . EC. INT. AND.OUT ( JJ-2) .EO.LP) 

* GO TO 3 

GO T0I3l,22,ll»12,13,15),KC0E 

22 L2 = L/2+1 
JJ = JJ-1 

GUT(JJ) * IVALUEIL2) 

GO TC 6 

3 IFITEMP. NE.CM. AND. TEMP. NE.RP) GO TC A1 
GO T0(A2,A3,6,AA,A5,A6)fK0DE 
31 CALL MSG(55,INII-2), INt 1-1 )» A I 
READ 101, INI 
DO A 11*1,86 

IF t INI ( 1 1 1. NE.BLK } GO TO 5 
A CONTINUE 
GO TC SS 

5 CALL NM8R IIN1,I,88, I AN$R » G 16 ) 

JJ * JJ-1 

OUTUJ) = IANSR 

CALL NMECNUIIMI-2) , IANSR) 

GO TO 6 


56 



* u 


16 CALI MSG (57 » A, B ( C) 

GO TO 31 
6 JJ = JJ41 

OUT ( J J ) = TEMP 
8 CONTINUE 
IE * JJ 
GO TC 100 

11 CALL MSG(59,IN(I-2» # INII-n.A) 
GO TC 99 

12 CALL NSG164,IN(I-2!,IN( I-1)*A » 
GO TO 99 

13 CALL MSG(65» INI I-2),1NU~1) .A) 
GO TO 99 

15 CALL MSGI132tIN(I-2),INU-l)fA) 
GO TO 99 

41 CALL HSG(159,A,8,C> 

GO TO 95 

42 CALL MSG! 160 1 1 N ( 1-2 ) # I N ( I- 1 I ■ A ) 
GO TO 99 

43 CALL MSGtl61»lN! 1 — 21 «IN(I-1)>A) 
GO TC 99 

44 CALL MSGI162,IN( I-2ltINU-l ),AI 
GO TO 99 

45 CALL N5G( l56,IN(I-2>, IN! I-UtA ) 
GO TO 99 

46 CALL MSG (157, IN! 1-2) , INI 1-1 ),A) 

99 RETURN 1 

ICO RETURN 

101 FORMAT ( 88 A 1 ) 

END 


EVAL, EVAL1 

SUBROUTINE EVAL! INPUT t I S « I E , I AN S » * ) 

DIMENSION INPUT!!) 

INTEGER TEN F » R P 
DATA L P * PP / * (*,'»•/ 

CALL PRESS1 ( INPUT* IS* IE »£ 1 1 ) 

ENTRY EVAL1I INPUT, IS*I£*IANS t *) 

12 I ENG = I E 

13 ILP = C 
IRP = C 

00 15 1=1 t I ENC 
TENP= INPUT ! I I 
IF!TEMP.NE.IPI GC TO 14 
ILP=I 
GC TC 15 

14 IFtTENP.NE.RP) GO TO 15 
IRPs I 

CALL EXPR( INPUT, ILP, IRP , I ENC , £50, SI l) 

IF! I END .C-T . 1 } GO TO 13 
GO TO 16 
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15 CONTINUE 

10 I F C ILP.NE.O.CR.IRP.NE.Ol 60 TO 17 
IFMENO.EC.l) GC TO 16 

IIP=C 

IRP=IEN0+1 

CALL EXPR (INPUT, UP, IRP, I END, £50, 611 ) 

16 IANS * INPUT (lENDi 
RETURN 

17 CALL PSG(58,A,B,C) 

11 RETURN 1 

50 1ST * ILP+i 

CALL 1NTIT! INPUT! 1ST), IANS, S1U 
INPUT 1 1 LP-2 1 * IANS 
1ST = I L P-1 
N1 = IFP + 1 
J = I ST-1 

IFfNl.GT-IENC) GO TO 52 
DO 51 I = M , I END 
J * J + l 

51 I N PUT ( J ) * INPUTIIJ 

52 IENO * J 
GO TO 13 
END 


USRFCT 

c 

SUBROUTINE LSPFCT (I NPUT, N1 , N1 , ILP , IRP ,LST, I NDEX , * ) 

C RETURN OK 

C RETURN 1 

COPMGN /FCTS/NFCT,L$TI,IUSFCT( 1000) 

DIMENSION I N PUT ( 1 ) » NP ( 20 1 
INTEGER ARG ( 1C 1 *CP, BLK 
DATA B L K ,C P/ * •,*,*/ 

NARG1 * 0 
DC 3 J*N1»N2 

IFI INPUTUNEC.BLK. OR. INPUT! JKEQ.CM) GO TO 3 
NARG1 = NARGI+I 
JF(NARGl.GT.iO) GO TO 15 
ARGINARG1 ) = INPUT! J) 

II * 2*NARG 1+2 + INDEX 

NP ( 2 + NARG l- 1 ) = IUSFCT(Il) 

NP (2*NARG1 ) = IUSFCTU1 + 1) 

3 CONTINUE 
J = 441 
K = LST+1 
N * LST-1RP 
IF(N.EQ.O) GO TO 2 
DC 1 1=1, N 
J = J-l 
K = K*1 

1 INPUT 1J) = I N PUT ( K 1 

2 NARG = IUSFCT1 INDEX + 3 ) 
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IF(KARG.NE.2*NARG1) GO TO !5 
Nl * INDEX+NARG+4 
N2 » IUSFCT UNDEX + 21-1 

CAIL RESLV2(IUSFCT,N1,N2, I NPUT ULP-2 > ,NARG,NM, ARG, £99) 

JJ * N2+ILP-3 
IFUJ.GT.J) GO TO 14 
IF! J J .EC. J ) GO TO 10 
IFU.EQ.441) GO TQ 10 
OC 9 I*J,44C 
JJ * JJ + 1 

9 INPUT ( J J ) * INPUT ( I > 

10 LST = JJ 
GO TO ICO 

14 CALL MSG(6Q*A,B»C) 

GO TO 99 

15 CALL MSG 1128, IUSFCT { INDEX) , IUSFCT ( INDEX+t), I USFCT (INDEX + 3 ) /2 ) 
99 RETURN 1 

100 RETURN 
END 


PGMFCT 

SUBROUTINE PGMFCT U FN, ARG I, ANS 1 ) 

3 GO TO (501,502,503,504,505,506,507,508,509,510, 

* 51 1,5 12, 513, 514, 515, 516, 5 17, 518), I FN 

501 ANSI * EXP ( ARG! ) 

GO TO 60C 

502 ANSI = ALCGfARGl) 

GC TC 600 

503 ANSI = AtDGlO(ARGl) 

GO TC 6C0 

504 ANSI = AR5IMARG1I 
GC TC 6CC 

505 ANSI = ARCCS(ARGl) 

GC TC 600 

506 ANSI = ATAN(ARGl) 

GC TO 600 

*07 ANSI * 5 IN 1 ARG l ) 

GC TC 60C 

508 ANSI = CCS(ARGl) 

GC TC 60C 

509 ANSI = T AN { ARG 1 ) 

GC TO 600 

510 ANSI = SORT ( ARG1 ) 

GC TC 600 

511 ANSI * TANH1 ARG 1 ) 

GO TO 600 

512 ANSI * SINH(ARGl) 

GC TC 600 

513 ANSI = CCSHIARG1) 

GO TG 60C 

514 ANSI = ERFtARGl) 
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GO TO 600 

515 ANSI * ERFCIARG1) 
GO TO 600 

f 16 ANSI » GAMMA(ARGl) 
GO TO 600 

517 ANSI = ALGAMA t ARG1 1 
GO TO 600 

510 ANSI » ABSIARG1) 
600 RETURN 
END 


EX PR 

SUBROUTINE EXPR ( I NPUT , I L P , IRP *L$T, *, * ) 

DIMENSION INPUTtl) 

LOGICAL FCT 

INTEGER TEMP,A$,SH,PL,AS2,8LK,CM 
DATA LP»CM/M'f 

DATA AS,SH,Pl,MI,AS2»BLN/'* , ,V ,' + *.'-*»****, * »/ 

FCT = .FALSE, 

IST=!LP+1 

INDslRP-l 

IF 1 IST.LT.4 ) GO TO 1 
TEMP* INPUT! I ST— 2 J 

IF I TEMP. EQ. AS, OR. TEMP. EC. SH.OR.TEMP.EQ.PL. OR.TEMP.EQ. MI .OR. 
♦TEMP.EQ.AS2.0R.TEHP.EC.LP.0R.TEMP.EC.CM) GO TO l 
FOT = .TRUE. 

1 IF f IST.GE . INC ) GO TO 6 
J = I ST- l 

DO 2 1= I ST* INC 
J*J + 1 

TEMP® INPUT ( I J 

IF ! TEMP. NE.ELK) INPUT (J)*TEMP 
IF tTEMP.NE.AS2 ) GO TO 2 

CALL EXPON! INPUT! J-l ) * INPUT U + l ) , IANS, ESS J 

INPUT!J-l)=IANS 

INPUT!! ) = BLK 

INPUT! I*l)sBLK 

J*J~2 

2 CONTINUE 
IND= J 

IF (1ST. EQ. INC ) GO TO 6 
J* I ST— 1 

CO 3 1= 1ST » IND 
J=J + 1 

TEMP* INPUT! I ) 

IF (TEMP.NE.8LK) INPUT (J)*TEMP 
IF(TEMP.NE.SH.ANC.TEMP.NE.AS) GO TO 3 

IF 1 TEMP. EQ. AS) CALL MULT (INPUT! J-l), INPUT U + l ) * I ANS, ESS) 
IF(TEMP.EQ.SH) CALL DVD ( INPUT! J-l ), INPUT ( 1+ 1 ), I ANS, ESS) 

INPUT (J-l )= I ANS 
INPUT! I )*BLK 
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INPUT U+li*eLK 

J=J~2 

3 CONTINUE 
I NO® J 

IF ( 1ST. EC. INC) CO TO 6 
J® I ST-1 

DO 4 1= 1ST* INC 
J® J+l 

TEMP® INPUT f I ) 

IMTEMP.hE.BLK) INPUT (J )=T£NP 
IEITEMP.NE.PL. AND. TEMP. NE-MU GO TO A 

IF (TEMP.EQ.PL 1CALL AOD( INPUT ( J- 1) , INPUT ( I + l J , IANS, £99 I 

IF (TEMP. EQ. MI ) CALL SUB (I NPUT I J- 1 ) , I NPUT (I + 1 ) , IANS, 099) 

INPUT I J— LILIANS 

INPUTU } = BLF 

INPUT (I+l )«RLK 

J® J— 2 

A CONTINUE 
I NO® J 

IFIFCT) GC TC 7 
IFfIST.EG. IND) GO TO 6 
CALL MSG(66, A,B,C) 

GO TC 99 

6 I F ( ILP.NE.CI GO TO 7 
LSI® t 

INPUTtn® INPLTIIST) 

GO TC ICO 

7 INPUT (ILPJ®INPUT ( 1ST) 

IFI.NOT.FCT) GO TO 72 

CALL F N D N A M ( INPUT ( ILP-2 ) * INDEX, NODE ) 

GC TO (73, 1C2, 70, 103,71,751, NODE 

70 CALL USRFCTUNPUT, 1ST, IND, UP, IPP,LST, INDEX, £99 » 

GO TO 100 

71 IF I INCEX .EQ. 19 t RETURN 1 

CALL PGNFGT I INDEX, I NPLT ( I ST I , IANS) 

INPUT ( I LP-2 ) = IANS 
1ST ® ILP-t 
GO TO 72 

73 CALL LOAD l INPUT ( ILP-2 ) ,KDCF I 
GO TO (7A,1CU»KC0E 

7 A CALL MSG( 129, INPUT! ILP-2) ,!NPUTI I LP-l ) » A I 
75 CALL USRPGMUNPUT, 1ST, INO, ILP, IANS, C991 
INPUT { I LP-2 > = IANS 
1ST ® ILP-1 

72 h.l ® IBP + 1 
U® I ST~l 

IFIN1.GT.LST) GO TO 9 

00 8 I = M,LST 

J=J+I 

8 INPUT (J )= INPUT I I ) 

9 LSI * J 
GO TC ICC 

101 CALL MSGI69, INPUT( ILP-2 >, INPUTULP-1) ,A) 

GO TO 99 



102 CALL MSCC1C6, INPLTULP-2) tINPITf ILP-l) ,A) 
GC TC 99 

103 CALL HSGU09, INPUT! UP-21 , INPUT! ILP-11, A) 
99 RETURN 2 

ICO RETURN 
END 


EXPON, DVD, MULT, ADD, SUB 

SUBROUTINE EXPCN l XI ,X2, ANS • * ) 

INTEGER OP 1 5 )/•**',» , »-«/ 

ICP = 1 
I = X 2 

IFIFLCAT1 I J.EC.X2) GC TC 1 
ANS = X 1**X2 
CALL CVERFLIJI 
GO TO 12* IOC *3 } * J 

1 ANS * X1**I 
CALL OVERFUJ) 

GO TO ( 2 * ICC , 3 } t J 
ENTRY DVD !X1,X2,ANS,*) 

ICP = 2 

IFIX2.EC.0) GO TO A 
ANS = X1/X2 
CALL OVERFLtJJ 
GC TC !2»1CC,3),J 
ENTRY PULJ(XI»X2»AN5»*J 
IOP = 3 
ANS = X 1*X2 
CALL OVERFLIJJ 
GO TO (2* IOC, 3 J , J 
ENTRY ACCtXl ,X2,ANS,+) 

ICP = 4 
ANS = X1+X2 
CALL CVEPFL(J) 

GO TC ( 2 , IOC ,3 ) , J 
ENTRY SUE!X1,X2,ANS,*) 

ICP = 5 
ANS = X1-X2 
CALL CVERFLIJ) 

GC TC 12, IOC, 3), J 

2 CALL RSGU53,X1,CPUCP) ,X2> 

GC TO 99 

3 CALL RSG(15A,X1,CP( ICP I,X2I 
GO TO 99 

4 CALL RSG(7C,A,B,CI 
99 RETURN 1 

100 RETURN 
END 


62 



SUBRCUT I NE FCFX(ARG,IANS,*I 
DIMENSION I N TMP ( A A 1 ) 

INTEGER TEMP ,RP 
DATA tP,RP/» (*,*!’/ 

CGMMGN/FCTS/NFCT»LSTI,IUSFCTIlGOOI 
COM PC N/NANCV/ I NCEX ,N ARG » NA ,NB 
N I » NA 
N2 * NB 

CALL RESLV2HUSFCT,N1,N2, INTMP, N ARG* lUSFCTt 1NDEX+4 ! , ARG , £98 ) 

12 IENO = N2 

13 IIP = C 
I R P=0 

DO 15 1=1, IENO 
TEMP* INTMP I I ) 

IFITEMP.NE.LP> GC TO 14 
I LP= I 
GO TC 15 

14 IF(TEMP.NE.PP) GC TO 15 
IRP=I 

CALL EXPP ( INTMP , ILP, IRP, I END , £50 , £98 ) 

I F I IEND.GT.1 ) GO TO 13 
GO TO 16 

15 CONTINUE 

I F I IIP.NE.0.CR.IBP.NE.01 GO TO 17 
IF ( IEND.E0.1) GO TO 16 
I LP = 0 

I R P= I ENC+ 1 

CALL EXPR (INTMP, ILP, IRP, I END, £50, £98) 

16 IANS = INTMFIIENDl 
RETURN 

17 CALL MSG (58,A,B,C) 

GO TC 99 

50 CALL MSG( 165 , I USFCT II NDEX ) , I USFCT (I NDEX + 1 ) » A) 

GO TC 99 

98 CALL MSG(120,IUSFCTI INDEX ), IDSFCTI INDEX+1), A) 

99 RETURN 1 
END 


INTIT 


SUBROUTINE INTIT ( INPUT , ANS, * ) 

DIMENSION INPUT ( 1 ) 

COMMON /FCTS/NFCT,LSTI, IUSFCTI 1000! 

COMMCN/NANCT / I N CEX , NARG ,NA ,N R 

INTEGER CM,ELK,RP 

CATA CM » BLK , RP/ • , * , * *,'>’/ 

I F ( INPUT13) .NE.CM.OR. INPUT (5) .NE.CM.OR. ( INPUT < 7 ) .NE .RLK . AND . 
* INPUT I7I.NE.RP) ) GO TO 1 



on* 


CALL FNC N A M ( INPUT (1)»INCEX*K0DE) 

GO TG(2 f 3tA t 5»6 f 7) »KODE 

4 NARG = IUSFCT { INDEX+3) 

IF ( NARG.GT.2 ) GC TD 8 
NA = INDEX+NARG+4 

NB = IUSFCT I1N0EX+2)— 1 

CALI SI MPS1( INPUT 14), INPUT 16), AN S» £98, 0991 
GC TO 100 

38 CALL N$Gtl22»INPUT(l)» INPUT(2)»AJ 
GO TO ICC 

1 CALL M$G(l63,INPtiT t 1),INPUT(2)»AJ 
GO TO 99 

2 CALL M$GU6C,INPLT( 1), INPUT (2) ,A) 

GO TC 99 

3 CALL MS6(l61tINPUTIl>»INPUTI21»AJ 
GO TC 99 

5 CALL «SGtl62,INPUTm»INPUT(2)»A) 

GO TO 99 

6 CALL MSGI156»INPUT( 1),INPUT(2)*A) 

GC TO 99 

7 CALL NSG(157» I NPUT ( I ) , INPUT (21,A> 

GO TC 99 

8 CALL MSG 1 127, IUSFCTI INDEX } , LUSFCTt INDEX + U,A} 
99 RETURN 1 

ICC RETURN 
END 


INTGRL 

SUBROUTINE TO DO INTEGRALS FOLLOWING INTEGRATE COMMAND 
SUBROUTINE INTGRL 
LOGICAL NUM.EOSIGN, DEBUG, PRCCEC 
R E A L * 8 GARB 

DIMENSION INPUT (441 ) ,NN (3) , T NPCT E 90 i 
COMMON /FCT S/NFCTrLST I , IUSFCT ( 1000 > 

CO MM ON /MODE 1 / DEBUG, PROCED 
COMMON /NANCV/INO t NARG,NA,NB 
DATA INPOT (1) t INPCT(90) / M ' » ') ’ / 

INTEGER ELK 
DATA ELK /• '/ 

IF ( .NOT . PRCCED ) GO TO 10 
CALL MSGf 121,G,G,G1 
RETURN 

C ASK FOR INTEGRAND 

10 CALL MSG(5,G,G,G1 

1 CALL READT1 1 INPUT ? NM, K , NUM* ILP, IRP, IEQ. IQK, IOP, ILST ) 

EQSIGN = .FALSE. 

IF( ILST.EC.C ) GO TO 100 

11 IFI.NCT.NUM1 GO TO 12 

C NUMBER ENCOUNTERED 

CALL MSGI112,G,G,G) 

GO TO 1 
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12 IFIK .l£. 8> GO TO 13 

C TOO MANY CHARACTERS 

CALL MSGO.NMIll ,NM(2)»NM(3)1 
GO TO 1 

13 IFUEQ .EC. OJ GO TO 2 

C * SIGN FOUND. ASSUME DEFINITION 

ECSIGN = .TRUE. 

IFUOP.EQ.O .OR. IOP.GT.IEC) GC TO 14 
C OPERATOR BEFORE = SIGN 

CALL MSG 1 1 1 3 ,G t G t G) 

GC TO 1 

1 A IF f IQ M .EC. 01 GO TO 15 
C QUESTION MARK FOUND 

CALL M$G( 114 .G.G.G) 

GO TO l 

15 IF { IRP.GT.O .AND. IRP.LT.1EQ1 GO TO 16 

C NO RIGHT PAREN BEFORE = SIGN 

CALL MSGi 1 15, G.G.G) 

GO TC 1 

16 IF ( ILP.GT. 0 -AND. ILP.LT.IRP) GC TO 2 

C NO LEFT PAREN BEFORE RIGHT PAREN 

CALL MSG(116.G,G.G) 

GO TO l 

C GET NAME SET UP 

2 CALL FN0NAMINM(21, INDEX, KODE) 

INC = INDEX 

I F ( KCC E .N E . 3 1 GO TO 21 
IF( .NOT. ECSIGN1 GO TO 21 
C USED NAME ALREADY DEFINED 

CALL NSGI48,NN(21»NM<3),G1 
GO TO 1 

21 IFlKCDE.NE.il GO TO 22 
IFIEGSIGM GC TO 22 

C NAME NCT DEFINED 

CALL MSG(A1,NMI2),NMI31.G1 
GC TC 1 

22 IFIKCDE.NE. 2) GC TO 23 

C VALUE 

CALL NSG<47,NM(2>,NM(31,G) 

GO TC 1 

23 IF! KCCE.NE.4 1 GO TO 24 

C PROCEDURE 

CALL MSGI53.NMI2) . NM (3 1 .G 1 
GO TC 1 

24 I F { KCCE.NE.5 ) GO TO 25 

C SYSTEM FUNCTION 

CALL MSG ( 54 .NMt 2 1 .NM { 3 ) »G 1 
GO TC I 

25 IF t KODE .NE.6 1 GO TO 26 
CALL MSG(l3fc»NM( 21.NMI3I.G) 

GO TC 1 

26 I F t KDDE.EC • 3 1 GO TO 4 

3 IE * IEC ♦ 1 

CALL FNECEX(NM121. INPUT .ILP.IRP. IE, ILST1 
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CALL FNCNAM1NM (2 1, INDEX, KODE) 

IND * INDEX 
IF [ KODE .EC.3 ) GO TO 4 
GO TO 1 

FUNCTION NCfe DEFINED 
ASK FOR ENDPOINTS 

4 CALL MSG(U7,G»G,G1 
READ 200, UNPCTU 1,1*2,89) 

200 FORMAT ( 88A1 1 
DC 17 1*2,89 

IF ( IN POT (U .NE.BLK) GO TO 18 

17 CONTINUE 
GO TO IOC 

C CONVERT THE ENDPOINTS 

18 KKK = 1 

5 CALL CNVRTUNPOT, KKK, 90,1, A , C ARB » CHAR , 67, 66 , £8) 
GO TO 7 

6 CALL CNVRT (INPOT , KKK, 90, 1, B, GARB, CHAR, E7,S7, 681 

C BOTH A AND B OK 

NARG = IL5FCT ( IND+3) 

IF! NARG.GT.2) GO TO 27 

NA * TNO+NAFG+4 

NB * IUSFCT I IND+21-1 

CALL SIMPSl (A, 8, ANSW, 698,6100) 

GC TC 99 

98 CALL K$Gf 122»NM(21,NM{31,G1 

99 CALL KSG(118,ANSK,G,G1 
100 RETURN 

7 CALL MSGI 119,G,G,G) 

GO TC 4 

8 CALL MSG(76,CHAR,G,G1 
GC TO 4 

27 CALL MSG(127»IUSFCT{ IND}, IUSFCT t IND+l 1 , G 1 
GO TO 100 
END 


SIMPSl 

SUBROUTINE $ I MPS II XM IN , XMAX »ANS ,*,* 1 

DIMENSION V (200 1,H 12001, At 200) ,812001 ,012001 »P 12001 ,E{200) 

DATA T/3.CE-4/ 

IF(XMIN.EQ-XMAX) GO TO 18 
V ( 1 1«XMIN 

HI1)=G,5*(XMAX— XMIN) 

CALL FOFXtXMIN.Afl) ,61001 
CALL FOFXtXMIN+Htn.BUl ,61001 
CALL FOFXIXMAX, CI1) ,61001 
PI 1 )sHIUMAm*4.0*B(l)+Cm) 

E(l)*P(l) 

ANS=P ( 1 1 
N»1 

FRAC=2.0*T 
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n t 


1 FRAC=0.5*FR AC 

2 TEST=A8S (FR AC*ANS ) 

K=N 

3 DO 7 I=l,K 

4 IF(ABS(E(I) ) .LE.TEST ) GO TO 7 

5 N = N + l 
V(N>*V(I)*HU) 

H(N J = 0.5*HU ) 

A<N)*em 

CALL FOFXmNHH(N),B(N),£lOO ) 

cm=cm 

P(N)®H(N)*(A(N ) + 4.0*6 I N ) +C ( N ) ) 
Q=PC I) 

HII >=H(N) 

CALL FOFXIVC IHHII) ,B( I ),C100) 
CUMIN) 

PCI )=HIII*( AU) *4.0*80 l+cm 1 

Q- P 1 1 )+PIN)-0 

ANS=ANS+C 

EII)=C 

ECN)=Q 

6 IF I N-200 ) 7,13,13 

7 CONTINUE 

8 IF (N-K) 9,9,2 
90= o.o 

10 DC 11 1=1, N 

11 o=Q*em 

12 IF I ABS(Q)-T*ABS< ANS) > 14,14,1 

13 RETURN 1 

14 AN S=C .0 

15 DO 16 1=1, N 

16 ANS=ANS+P( 1 1 

ANS = (ANS+C/30. 01/3.0 

17 RETURN 

18 ANS = C.C 
RETURN 

100 RETURN 2 
ENO 


MAIN PROGRAM, DECK NAME CREATE, RUN TO 
IMPLICIT INTEGER l A-Z 1 

DIMENSION vcvuDnii^ni . uruunc rim .ruunt t i 
DATA NKEY 
REWIND 5 

WRITE (5,201) NKEYS,K£ YWRD ,NCMNCS »CMNOS» PGMS 


CREATE KEYWORDS FOR 


CIT INTEGER I A-Z 1 
SION KE YWRO 1 3,20 ) ,NCMNDS ( 20 ) »CMNDS (3,33 ,20 ) »PGMS (2,33,20) 
NKEYS»KEYWRD»NCMNDS»CMNDS , PGMS/ 0,60** ‘,20*0,3300** •/ 

ID 5 


END FILE 
REWIND 5 
RE AO (5,201) 
STOP 
FORMAT 
END 


NKEYS, KE YWRD, NCMNOS,CMNOS, PGMS 
(I4*3(/,20A4)»/» 2014, 165 (/,20A4) 1 


CREATE 

INITAL 
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c 


MSG 


SUBROUTINE NSG t I .A, 6,C ) 

GC TO (1,2, 3, 4. 5, 6, 7,8,9,10,11, 12, 13, 14, 15, 16, 17,10,19,20,21,22,23 
1, 24,2 5, 26,2 7,20,29, 30,31 ,32 *33,34,35 ,36, 37, 38, 39 ,40 ,41 ,42,43,44,45 
2, 46, 47, 46, 49, 50, 51, 52, 53, 54, 55, 56, 57, 56, 59, 60, 61 ,62,63,64,65,66,67 
3,66,69,70,71,72,73,74,75,76,77,78,79,00,01,82,83,84,85,86,87,88,89 
4,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104, 105, 106,107, 
5108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123, 
6124,125,126,127,126,129,130,131,132,133,134,135,136,137,138,139, 
7140,141,142,143,144,145,146,147,148,149,150,151,152,153,154,155, 
8156,157,158,159,160,161, 162,163,164,165), 1 


1 

PRINT 

5C1 


CO TC 

race 

2 

PRINT 

502 


GO TO 

loco 

3 

PRINT 

5 03 * A * B *C 


GO TC 

1000 

4 

PRINT 

504 


GO TO 

IG0C 

5 

PRINT 

505 


GO TC 

1000 

6 

PRINT 

506 


GO TO 

1000 

7 

PRINT 

507 


GO TO 

icce 

8 

PRINT 

508 


GO TO 

1000 

9 

PRINT 

5 C9 


GO TC 

1000 

10 

PRINT 

5ICfA*8*C 


GO TO 

1000 

11 

PRINT 

511 


GO TC 

10CO 

12 

PRINT 

512 


GC TC 

1000 

13 

PRINT 

513 


GC TO 

1000 

14 

PRINT 

514* A*B*C 


GO TO 

1000 

15 

PRINT 

515 


GO TO 

1000 

16 

PRINT 

516 


GC TO 

1000 

17 

PRINT 

51? 


GO TO 

1000 

18 

PRINT 

518 


GO TO 

1000 

19 

PRINT 

515 


GC TO 

1000 

20 

PRINT 

52C 


GO TO 

1000 

21 

PRINT 

521 


GO TO 

1000 

22 

PRINT 

5 22 
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GC TO 

1CG0 

23 

PRINT 

523*4, B 


GO TC 

LOCO 

24 

PRINT 

524,4 T 8 


GO TO 

1000 

25 

PRINT 

525 


GO TO 

IOCO 

26 

PRINT 

526 


GC TO 

1000 

27 

PRINT 

527 


GO TC 

i€€0 

20 

PRINT 

528 


GO TC 

1CCC 

29 

PRINT 

52S 


GC TC 

1000 

30 

PRINT 

530 


GO TC 

1CCG 

31 

PRINT 

531*4,6 


GO TO 

1CC0 

32 

PRINT 

5 32 


GC TC 

IOCO 

33 

PRINT 

533 


GO TO 

IOCO 

34 

PRINT 

534 


GO TO 

1000 

35 

PRINT 

535 


GO TC 

IOCO 

36 

CONTINUE 


GC TC 

IOCO 

37 

PRINT 

537 


GO TO 

IOCO 

38 

COM INUE 


GC TC 

1CC0 

39 

PRINT 

535 


GC TO 

1000 

40 

PRINT 

54 C 


GO TC 

1000 

41 

PRINT 

541,4*6 


GC TC 

1000 

42 

PRINT 

542*A,B,C 


GC TC 

IOCO 

43 

PRINT 

543*4*0 


GO TO 

1000 

44 

PRINT 

544,4* B 


GO TO 

1 OOQ 

45 

PRINT 

545 


GO TO 

1000 

46 

PR INT 

546,4,6 


GO TC 

1000 

47 

PRINT 

547*4,6 


GO TO 

1000 

48 

PRINT 

548, 4, B 


GO TO 

1000 

49 

PRINT 

549 
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GC 

TO 

1000 


50 

PR 

INT 

550 



GG 

TC 

1000 


51 

PR 

INT 

551 * A 

.8 


GO 

TC 

ICCO 


52 

PR 

INT 

552 



GC 

TC 

1000 


53 

PRINT 

553 , A 

.8 


GO 

TO 

1000 


54 

PRINT 

554 , A 

? 8 


GG 

TO 

1000 


55 

pr: 

INT 

555, A 

.B 


GO 

TC 

1000 


56 

pr: 

INT 

556*4 

»B 


GG 

TO 

1CCC 


57 

pr: 

[NT 

557 



GC 

TO 

iCGG 


58 

PR 

INT 

558 



GO 

TC 

1000 


59 

pr: 

[NT 

559, A 

, 8 


60 

TC 

ICCO 


60 

pr: 

ENT 

560 



GO 

TC 

1000 


61 

pr: 

[NT 

56 1 , A 

»B 


GC 

TC 

1000 


62 

PR] 

ENT 

562, A 



GG 

TO 

1000 


63 

PR] 

INT 

563, A 



GC 

TO 

1000 


64 

PR] 

INT 

564, A 

» 8 


GO 

TO 

ICCO 


65 

PRINT 

565, A 

, 8 


GG 

TO 

1000 


66 

PRINT 

566 



GO 

TO 

1000 


67 

PRINT 

567, A 

t B 


GO 

TO 

10C0 


68 

PRINT 

568 



GC 

TC 

1000 


69 

PR] 

;nt 

569, A 

, B 


GO 

TO 

loco 


70 

PR] 

[NT 

570 



GO 

TO 

ICCO 


71 

CONTINUE 



GC 

TC 

1000 


72 

CONTINUE 



GC 

TO 

10CC 


73 

CONTINUE 



GC 

TO 

ICCC 


74 

PRINT 

574 



GO 

TO 

l GOO 


75 

PRI 

NT 

575 



GO 

TO 

1000 


76 

PRI 

NT 

576, A 
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GO TO 1000 

77 PRINT 577. A. 8, C 
GO TO 1000 

7a PRINT 578, A 
GO TO 1000 

79 PRINT 579,A,B,C 
GO TO 1000 

80 PRINT 560 , A,6«C 
GO TO 1000 

61 PRINT 581, A, 8, C 
GO TO 1000 

B2 PRINT 582 
GO TO 1000 

83 PRINT 583,A,B,C 
GO TO 1000 

84 PRINT 584 
GO TO 1000 

85 PRINT 585 
GO TO 1000 

86 PRINT 586, A 
GO TO 1000 

87 PRINT 587 
GO TC 1000 

88 PRINT 588 
GO TC 1000 

89 PRINT 589, A, B 
GO TO 1000 

90 PRINT 590, A, B 
GO TO 1000 

91 PRINT 591. A, B 
GO TO 1000 

92 PRINT 592, A, B 
GO TO 1000 

93 PRINT 593 
GO TO 1000 

94 PRINT 594 
GO TC 1000 

95 PRINT 595 
GO TO 1000 

96 PRINT 596 
GO TO 1000 

97 PRINT 597 
GO TO 1000 

98 PRINT 598 
GO TO 1000 

99 PRINT 599 
GO TO 1000 

100 PRINT 600 
GO TO 1000 

101 PRINT 601 
GO TO 1000 

102 PRINT 602 
GO TO 1000 

103 PRINT 603, A, 8 
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GO TO 1QOO 

104 PRINT 604, A 
GO TO 1000 

105 PRINT 6C5»A,B,C 
GO TO 1000 

106 PRINT 6C6,A,6,C 
GO TO 1000 

107 PRINT 607, A 
GO TO 1000 

106 PRINT 608 , A* 6 
GO TO 1000 

109 PRINT 609* A, 6 
GO TO 1000 

110 PRINT 610, A, B 
GO TO 10C0 

111 PRINT 611 
GO TO 1000 

112 PRINT 612 
GO TO 1CC0 

113 PRINT 613 
GO TO 1000 

114 PRINT 614 
GO TO 1000 

115 PRINT 615 
GO TO 10C0 

116 PRINT 616 
GO TO ICCC 

117 PRINT 617 
GO TO 1000 

118 PRINT 618, A 
GO TO 1000 

119 PRINT 619 
GO TO 1000 

120 PRINT 620, A, 8 
GO TO ICCC 

121 PRINT 621 
GO TO 10C0 

122 PRINT 622, A, B 
GO TO 1000 

123 PRINT 623 
GO TO 1000 

124 PRINT 624 
GO TO 1000 

125 PRINT 625 
GO TC 1000 

126 PRINT 626 
GO TO 1000 

127 PRINT 627, A, B 
GO TO 1000 

128 PRINT 626,A,B,C 
GO TC 1000 

129 PRINT 629, A, 8 
GO TC ICCC 

130 PRINT 630, A, 6 
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J 


GO TO 1000 

131 PRINT 631,A,B,C 
GO TO 1000 

132 PRINT 632, A, B 
GO TO 1000 

133 PRINT 633, A, B 
GO TO 1000 

134 PRINT 634, A, B 
GO TO 1000 

135 PRINT 635, A,B 
GO TO 1000 

136 PRINT 636, A, B 
GO TO 1000 

137 PRINT 637, A, E 
GO TO 1000 

138 PRINT 638, A, B 
GO TO 1000 

139 PRINT 639 
GO TC 1000 

140 PRINT 640 
GO TC ICCO 

141 PRINT 641 
GO TO 1000 

142 PRINT 642 
GO TC 1CGC 

143 PRINT 643 
GO TO 1000 

144 PRINT 644 
GO TC 1 GOO 

145 PRINT 645,A»B,C 
GO TC 1000 

146 PRINT 646,A,B,C 
GO TO 1000 

147 PRINT 647, A,B,C 
GO TC ICCO 

148 PRINT 648 
GO TC 1000 

149 PRINT 649 
GO TO ICCO 

150 PRINT 650 
GO TC IOCO 

151 PRINT 651,A,B,C 
GO TC 1000 

152 PRINT 652 
GO TO 1C0C 

153 PRINT 653, A, 8, C 
GO TO 1000 

154 PRINT 654,A,B,C 
GO TO 1000 

155 PRINT 655,A,B,C 
GO TO 1000 

156 PRINT 656, A, B 
GO TO 1000 


157 PRINT 657, A, B 
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GO TO 10CC 
158 PRINT 6 5 8 , A 
GO TO IOOO 
155 PRINT 655 
GO TO 1CC0 

160 PRINT 660, A, 8 
GO TO 1000 

161 PRINT 661, A, 8 
GO TO 1000 

162 PRINT 662, A, E 
GC TO 1000 

163 PRINT 663, A, E 
GO TO 1000 

16 A PRINT 664 , A , 8 
GO TC 1CC0 
165 PRINT 665 , A, B 
1000 RETURN 

501 FORMAT (* READY* I 

502 FORMAT (' STATEMENT CANNOT BE CLASSIFIED.*) 

503 FORMAT I • *,3A4,' HAS MORE THAN 8 CHARACTERS.*) 

504 FORMAT 1 * PARENS DO NOT BALANCE-* ) 

505 FORMAT ( * ENTER USER FUNCTION NAME, DEFINE USER FUNCTION, OR PRESS 
♦RETURN TO CANCEL-* I 

506 FORMAT I* CHARACTERS AFTER ? IGNORED.*) 

507 FORMAT (* MORE THAN 12 CHARACTERS IN A COMMAND- * 1 

508 FORMAT t* STOP COMMAND NOT ALLOWED IN PROCEDURES.'} 

5 C5 FORMAT I* MORE THAN 2 CONTINUE LINES.*) 

510 FORMAT l* »,3A4,* NOT A COMMAND OR PROGRAM NAME.*) 

511 FORMAT {* INITIALIZATION COMPLETE.*) 

512 FORMAT I* RESTART COMMAND NOT ALLOWED IN PROCEDURES.') 

513 FORMAT <» NC RIGHT PAREN. MODE IGNORED.*) 

514 FORMAT <• *,3A4,* IS NOT A VAIIC MODE.*) 

515 FORMAT I* DEBUG MOOE IS ALREADY ON.') 

516 FORMAT <* DEBUG MODE TURNED ON.*) 

517 FORMAT <* DEBUG MODE TURNED OFF.*) 

518 FORMAT t* DEBUG MODE IS ALREADY OFF.*) 

519 FORMAT t* REAL*4 MODE IS ALREADY ON.*) 

520 FORMAT I* MORE THAN 12 CHARACTERS IN MODE OPTION. OPTION IGNORED') 

521 FORMAT {• NC OPTION FOUND IN MODE COMMAND.*) 

522 FORMAT (• MCDE CCMMAND NCT ALLOWED IN PROCEDURES.*) 

523 FORMAT I* *,2A4,' WAS NCT FCUND * ) 

524 FORMAT {' MCRE THAN 8 CHARACTERS IN *,2A4> 

525 FORMAT (' ElANK FIELD FCUND IN ERASE CCMMAND.*) 

526 FORMAT { * NC RIGHT PAREN FOUND. LAST NAME MAY NOT BF ERASED* I 

527 FORMAT I* YCU ERASED ALL NAMES*) 

528 FORMAT {• THERE ARE NC NAMES TO ERASE.*) 

529 FORMAT (• NC NAMES FOUND IN ERASE CCMMAND.*) 

530 FORMAT (* ERASE CCMMAND NOT ALLOWED IN PROCEDURES.*) 

531 FORMAT I* *,2A4,* MAY NCT BE ERASED. IT IS A SYSTEM SUPPLIED*, 

*« FUNCTION.* ) 

532 FORMAT t> DUMP OF VALUES.*) 

533 FORMAT {• NC VALUES DEFINED.*) 

534 FORMAT (' NC USER FUNCTIONS DEFINED.*) 

535 FORMAT (• DUMP OF USER FUNCTION NAMES-') 
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537 FORMAT I* COMP OF PROCEDURE NAMES.') 

539 FORMAT I* NO PROCEDURES DEFINED.') 

540 FORMAT {* GIMP COMMAND NOT ALLOWED IN PROCEDURES.*) 

541 FORMAT (' *,2A4,» COULD NOT BE FOUND.') 

542 FORMAT (* »»2A4#* IS A USER FUNCTION OF «,I3,» ARGUMENTS.') 

543 FORMAT (• «,2A4,* IS A PROCEDURE.') 

544 FORMAT I* *,2A4,* IS A SYSTEM SUPPLIED FUNCTION.’) 

545 FORMAT ( • NO ANSWER.' ) 

546 FORMAT I ' *,2A4»* NOT STORED.') 

547 FORMAT i* *,2A4 f ' ALREADY STORED AS A VALUE, FUNCTION NOT STORED*) 

548 FORMAT I* * , 2 A4 * • ALREADY STORED AS A USER FUNCTION.') 

54*3 FORMAT (• NOT ENOUGH ROOM TD STORE FUNCTION.') 

550 FORMAT (• NO ARGUMENT FCUND.* ) 

551 FORMAT (* THE ARGUMENT »,2A4,» HAS MORE THAN 8 CHARACTERS.') 

552 FORMAT {• FUNCTION DEFINITIONS NOT ALLOWED IN PROCEDURES.') 

553 FORMAT {» ',2A4,* ALREADY STORED AS A PROCEDURE, FUNCTION NOT*, 

** STORED.*) 

554 FORMAT (• *,2A4,» IS A SYSTEM FUNCTION. USER FUNCTION NOT', 

*■ STOREO.') 

555 FORMAT (• »,2A4 t * UNKNOWN. ENTER NUMBER OR PRESS RETURN TO', 

** CANCEL.*) 

556 FORMAT I* *,2A4,» MORE THAN 8 CHARACTERS. EVALUATION CANCELED.') 

557 FORMAT (• ERROR IN NUMBER C CN VE RS I ON. • ) 

558 FORMAT (« PARENS DO NOT BALANCE.*) 

55*3 FORMAT (• USER FUNCTION NAME *,2A4,» MAY NOT BE USED AS A VALUE*, 
** NAME.*) 

560 FORMAT {• EXPRESSION TOO LONG.') 

561 FORMAT I* TWO CONSECUTIVE OPERATORS, *,A4,« AND *,A4) 

562 FORMAT I* ILLEGAL OPERATOR *,A4) 

563 FORMAT (■ ONLY CNE CPERANO FOR *,A4) 

564 FORMAT (* PROCEDURE NAME *,2A4,* MAY NOT BE USED AS A VALUE NAME') 

565 FORMAT (* SYSTEM FUNCTION NAME *,2A4t' MAY NOT BE USED AS A*, 

4* VALLE NAME.' ) 

566 FORMAT [* YCU HAVE ROOM FOR ONLY ONE MORE VALUE NAME.') 

567 FORMAT {* »,2A4,* NOT STORED. NO ROOM.') 

568 FORMAT ( * ERROR IN EX PR , I ST. NE . I ND ’ ) 

569 FORMAT t* FUNCTION ',2A4,* UNKNOWN.') 

570 FORMAT (' DIVIDE BY ZERO.') 

574 FORMAT (* TOO MANY CHARACTERS IN A NUMBER. LIMIT IS 38.') 

575 FORMAT {» THE CHARACTER ",** FOUNO IN A NUMBER.') 

576 FORMAT (• 8 AC CHARACTER • , 1H* , A l , 1 H' , ' IN A NUMBER.') 

577 FORMAT {* * ,2A4t * = * ,G14.6 ) 

578 FORMAT {* *',G14.6) 

579 FORMAT (' ATTEMPT TG STORE • , G 14 . 6, • IN USER FUNCTION NAME', 

*2A4) 

580 FORMAT t* ATTEMPT TO STCRE * ,G14.6, * IN PROCEDURE NAME* , 2A4 ) 

581 FORMAT {• ATTEMPT TO STORE * ,G 1 4. 6, • IN SYSTEM FUNCTION NAME*, 

*2A4) 

582 FORMAT {• NC RIGHT PABEN. OUMP IGNORED.') 

563 FORMAT (3A4,* IS NOT A VALID DUMP CPTICN.*) 

584 FORMAT I* NC CPTICN FCUND IN DUMP COMMAND.*) 

585 FORMAT I* MCRE THAN 12 CHARACTERS IN DUMP OPTION.*) 

586 FORMAT {* READY *,I3) 

507 FORMAT t* BEGIN COMMAND NOT ALLOWED IN PROCEDURES.') 


75 



588 FORMAT (* NC NAME FOUND IN BEGIN COMMAND. RE-ENTER.*) 

589 FORMAT t* VALUE NAME ',2A4,' MAY NOT BE USED AS A PROCEDURE** 

*» NAME.*) 

590 FORMAT I* USER FUNCTION NAME *,2A4,' MAY NOT BE USED AS A', 

** PROCEDURE NAME.' ) 

591 FORMAT t* *,2A4,' IS ALREADY A PROCEDURE.*) 

592 FORMAT (* SYSTEM FUNCTION NAME *,2A4,' MAY NOT BE USED AS A** 

*» PROCEDURE NAME.*) 

593 FORMAT I* END COMMAND BEFORE BEGIN COMMAND. * ) 

594 FORMAT I* BLANK FIELD IN END COMMAND OPTION. ASSUME NO OPTION.') 

595 FORMAT I* NO < OR > FOUNO IN END COMMAND OPTION. RE-ENTER COMMAND 


*. ' > 

596 FORMAT l* FIRST EXPRESSION IN END COMMAND WAS NOT FOUND. RE-ENTER 
* COMMAND.' ) 

597 FORMAT l * RE-ENTER END COMMAND.*) 

598 FORMAT (* SECOND EXPRESSION IN END COMMAND WAS NOT FOUND.'* 

** RE-ENTER CCNMANO.* ) 

599 FORMAT (* DC COMMAND NOT ALLOWED IN PROCEDURES.*) 

600 FORMAT (• NC PARENS FOUNO IN DC COMMAND. RE-ENTER.*) 

601 FORMAT t* BLANK FIELD IN DC COMMAND OPTION. RE-ENTER COMMAND.*) 

602 FORMAT t» NO * FOUND IN DO CCMMAND OPTION. RE-ENTER COMMAND.') 


603 FORMAT I* ',2A4,' IS A VALUE NAME.*) 

604 FORMAT f* ITERATION NUMBER • , 1 10 , * IS LESS THAN 1 OR GREATER', 
*• THAN 50.' ) 

6C5 FORMAT I* ERROR IS IN STATEMENT *»I3,' OF PROCEDURE *»2A4> 

606 FORMAT I* END OF DO. ' ,G 13. 6,A1 ,G1 3.6) 

607 FORMAT (* END OF DO. »»I2,* ITERATIONS.*) 

6C8 FORMAT (■ VALUE NAME *t2A4,* MAY NOT BE USED AS A FUNCTION*, 


PROCEDURE NAME »,2A4,* MAY NOT BE USED AS A FUNCTION* 


EXCEEDED THE ROOM FOR PROCEDURES. 


>2A4, 


** NAME.*) 

609 FORMAT (* 

** NAME-*) 

610 FORMAT (* YOU HAVE 
*• NOT STORED.* ) 

611 FORMAT I * LINE HAS NO CONTENTS. RE-ENTER.*) 

612 FORMAT l* NUMBER FOUND WHERE NAME REQUIRED. RE-ENTER, 

613 FORMAT I * OPERATOR FOUND BEFORE = SIGN. RE-ENTER.') 

614 FORMAT! • QUESTION MARK ILLEGAL IN CONTEXT. RE-ENTER.') 

615 FORMAT !• NC RIGHT PAREN BEFORE = SIGN. RE-ENTER.') 

616 FORMAT! » NO LEFT PAREN BEFORE RIGHT PAREN. RE-ENTER.') 

617 FORMAT! • ENTER LOWER LIMIT* A COMMA, UPPER LIMIT, OR PRESS RETURN 


*) 


♦ TO CANCEL.' ) 

618 FORMAT!' THE INTEGRAL IS • * G15.6 ) 

619 FORMAT!' NC COMMA FOUND, OR TOO MANY COMMAS FOUND.') 

620 FORMAT I* ERROR IN EVALUATION OF USER FUNCTION *,2A4,*.W 

621 FORMAT!' INTEGRATE CCMMAND NOT ALLOWED IN PROCEDURES.*) 

622 FORMAT (' INTEGRAL OF ',2A4,' MAY NOT BE ACCURATE TO FIVE SIGNIFIC 


*ANT FIGURES.*) 

623 FORMAT I* NC LIST FOUNO IN PRINT COMMAND. COMMAND IGNORED.') 

624 FORMAT I* BLANK FIELD FOUND IN PRINT COMMAND.*) 

625 FORMAT !» MCRE THAN 9 NAMES IN PRINT CCMMAND. EXTRA NAMES', 

** IGNORED.*) 

626 FORMAT !* MCRE THAT 10 NAMES IN FUNCTION ARGUMENT LIST.') 

627 FORMAT {• MCRE THAN ONE ARGUMENT IN USER FUNCTION *,2A4,*.*) 

628 FORMAT {• FUNCTION *,2A4,* SHOULD CCN7A I N* , 1 3, * ARGUMENTS.') 
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629 FORMAT (' PROGRAM »,2A4»* LOADED.*) 

630 FORMAT 1* PROGRAM NAME • , 2A4 » • MAY NOT 8E USED AS A PROCEDURE NAME 

) 

631 FORMAT l* ATTEMPT TO STORE *,G14.6 f * IN PROGRAM NAME *,2A4) 

632 FORMAT I* PROGRAM NAME *,2A4,* MAY NOT BE USED AS A VALUE NAME.*) 

633 FORMAT I* »,2A4*» IS A PROGRAM NAME.*) 

634 FORMAT (• PROGRAM »,2A4,* NOT LOADED.') 

635 FORMAT (* *»2A4,» MAY NOT BE ERASED. IT IS A PROGRAM NAME.*) 

636 FORMAT (• *,2A4,' IS A PROGRAM NAME. USER FUNCTION NOT STORED.*) 

637 FORMAT <* MERE THAN 10 ARGUMENTS IN »,2A4) 

638 FORMAT I* ERRCR IN PROGRAM *,2A4> 

639 FORMAT (• ENTER USE KEYWORD.*) 

640 FORMAT (• ILLEGAL.* ) 

641 FORMAT I* LIST OF KEYWORDS.*) 

642 FORMAT I* NC KEYWORD IN TABLE.*) 

643 FORMAT (* ENTER KEYWORD YOU WISH TO SEE.*) 

6A4 FORMAT (' THIS IS A NEW KEYWORD.') 

645 FORMAT (' LIST OF COMMANDS FOR * , IH* , 3A4, 1H* ) 

646 FORMAT <» NC COMMANDS IN TABLE FOR KEYWORD • , 1 H • , 3 A4 , IH ' ) 

647 FORMAT (• DC YOU WISH TO DELETE KEYWORD ’ , IH ' , 3A4 , 2H* ? ) 

648 FORMAT I* ARE YOL FINISHED MODIFYING?*) 

649 FORMAT {• ENTER COMMAND.*) 

650 FORMAT (• ENTER PROGRAM ENTRY POINT.*) 

651 FORMAT (* DC YOU WISH TO MODIFY KEYWORD *, 1 H * , 3 A4 , 2H •? ) 

652 FORMAT {' MODIFICATIONS MADE.') 

653 FORMAT I* OVERFLOW IN COMPUTING ( * , G L4. 6 , • ) * , A2 » * ( ' , G 14 . 6 , » ) ' ) 

654 FORMAT (• UNDERFLOW IN COMPUTING I * »G 1 4 . 6 , • ) * , A2 , < f * , G 1 4. 6 , • ) • ) 

655 FORMAT (* AN OPERATOR IS REQUIRED BETWEEN *,A2,* AND *,2A4) 

656 FORMAT I* INTEGRATION FUNCTION EXPECTS A USER FUNCTION NAME. NOT 

♦ THE SYSTEM FUNCTION *»2A4) 

657 FORMAT I* INTEGRATION FUNCTION EXPECTS A USER FUNCTION NAME. NOT 
♦THE USER PROGRAM * T 2A4) 

658 FORMAT (* INTEGRATION FUNCTION EXPECTS A USER FUNCTION NAME. NOT 
♦THE VALUE *,G14.6) 

659 FORMAT (' FIRST ARGUMENT FOR THE INTEGRATION FUNCTION IS NOT A NAM 

♦ E. * ) 

660 FORMAT t* INTEGRATION FUNCTION EXPECTS A USER FUNCTION NAME. *t 
♦2 A4 * * UNKNOWN.*) 

661 FORMAT {' INTEGRATION FUNCTION EXPECTS A USER FUNCTION NAME. NOT 
♦THE VALUE NAME »,2A4> 

662 FORMAT l* INTEGRATION FUNCTION EXPECTS A USER FUNCTION NAME. NOT 
♦THE PROCEDURE NAME *,2A4) 

663 FORMAT (• INTEGRATION FUNCTION WITH USER FUNCTION *»2A4,* DOES NOT 

♦ CONTAIN THREE ARGUMENTS.*) 

664 FORMAT (* AN OPERATOR IS REQUIRED BETWEEN *tA2,* AND SG14.6) 

665 FORMAT (* USER FUNCTION *»2A4,* MAY NCT APPEAR IN THE INT FUNCTION 
*. IT CONTAINS THE INT FUNCTION.*) 

END 
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LOAD, LOADED, RUNIT 


ACCGNO 

GNCLiP PSECT 

ENTRY LOAD 
ENTRY RUNIT 
ENTRY LOADED 

SMCAL DC F»76* LENGTH OF SAVE AREA 

DC 18F * 0 * ZERC OUT SAVE AREA EXCEPT FOR LENGTH 

RTCHAR DS CL8 NAPE OF ROUTINE TO BE LOADED OR CALLED 
BCCNAM DS F ADDRESS OF THE NAME OF THE ROUTINE 

NPARM DS F AOORESS CF NUMBER OF ARGUMENTS TO BE PASSED TO FUND 

ARAPAR DS F ADDRESS OF THE FUNCTION ARGUMENTS 

AN5 DS F ADDRESS FOR RESULT OF FUNCTION CALL 

ERPCOO OS F ADDRESS CF ARGUMENT FOR ERRCOD 

EIGHT DC F * 8 * 

BLANK DC X * 4CCCOOOO * 

CHRMSK DC X * FFCCGGOO * 

PARLST DS 20F PARAMETER LIST TO BE BUILT FOR CALLED FUNCTION 
HSHIN1 OS F TEMP LOGS FOR HASH RESULTS 

HSHIN2 DS F TEMP LOGS FOR HASH RESULTS 

HSHIN3 DS F HASH SNITCH INDICATES WHICH TABLE LAST SEARCHEO 

BLANKS DS F 

MASPCS DC X , CFFFFFFF * MASK FOR HASH TO PREVENT OVERFLOW AND SIGNS 
ONE DC F * 1 * RETURN CODE AND CONSTANT 

TWC DC F ' 2 ' RETURN CODE FDR ERROR 

HSHDIV DC F * 128 1 HASH DIVISOR ALSO LENGTH OF MAIN ADCON TABLE 

FCURF DC F *4 • INCREMENTS FOR TABLE SEARCHES 

SIXF DC F 1 24 ' ENTRY SIZE FOR ACCCN TABLES 

LA5TCL DS F NAME OF LAST ROUTINE LOADED OR CALLED 

LASTCl OS F CONTINUATION OF NAME 

LACPT DS F INDEX POINTER TO ACCON FOR LAST ROUTINE CALLED 

L A DPT I DS F SWITCH TO INDICATE MAIN ADCON TABLE OR OVERFLOW TABLE 

CVFCPN DC F*0* NEXT AVAILABLE ENTRY LOC IN OVERFLOW ADCON TABLE 

TAfiFUL DC F'AOeC OVERFLOW TABLE FULL TEST CONSTANT 

BAS ADT DC AIADTA8L) BASE ADDRESS OF ACTABLE 

BASCAC DC AICVACT8) BASE ADDRESS OF OVERFLOW ADCON TABLE 

ACREND DC A(ENDPST) ADRESS FOR ENO CF PSECT NEEDED FOR BASE 

BASADR DC AILOACI EASE ADRESS FOR CSECT COVER 

ENTPT DS F ENTRY POINT INDICATOR USED FOR RETURNS OF INTER SUBS 

MAXARG DC F*20* MAXIMUM NUMBER OF ARGUMENTS ALLOWED 

ACTAfil 05 5F MAIN ADCON TABLE 128 ENTRIES 

PTC VF DS F PCINTER TO OVERFLOW ACCON TABLE ENTRY 

TAEACN DS 762F 6 WORDS PER ENTRY 

ENCPST DS F END OF PSECT 

0 V F #A0 CCM 

OVADTB OS F OVERFLOW ACCON TABLE 

NXCHPT DS F POINTER TO NEXT ADCON IN OVERFLOW ADCON CHAIN 
TA8CVF DS 1018F OVERFLOW ADCON TABLE IS ONE PAGE LONG 
GNCL#C CSECT R E ADCNL Y , PUBLI C 
USING LO A C * 1 5 
LOAD SAVE I 14*12) 
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L 14,72(C,13) LOAO 14 WITH OUT PSECT 
ST 14,8(C,13) SAVE IT BACK IN CALLING PROGRAM 
ST 13,410,141 SAVE CALLERS PSECT PT IN OUR SAVE AREA 
LR 13,14 SWITCH 13 TO OUR PSECT FOR BASE 
USING GNCL OP , 13 

LR 12,15 SWITCH TO 12 FOR CSECT BASE REG 
DROP 15 
USING LOAD, 12 
SR 10,10 
ST 10 ,E NIPT 

L 2,010,1) PICK UP AOORESS OF FIRST ARG 
ST 2 , SCON AM SAVE ADORESS 
L 3,4(0, I) PICK UP ADDRESS OF SECOND ARG 
ST 3,ERRC00 SAVE ADDRESS 

LM 4,5,0(21 LOAD 4 AND 5 WITH NAME OF FUNC TO BE LOADED 
B AO JNAM MAKE RIGHT ADJUSTED NAME LEFT AOJUSTED 
CHRLGD STM 4,5,RTCHAR SAVE LEFT AOJUSTED NAME 

C 4 , LASTCL CHECK TO SEE IF NAME IS THE SAME AS LAST TIME 
BNE HASH 
C 5,LASTC1 

BE RET I RETURN, NOTHING NEED BE DONE 
HASH LR 6,4 

LR 7,5 THE FOLLOWING SECTION OF CODING IS AN INTERNAL 
L 9 » MA SPCS SUBROUTINE TO CALCULATE THE HASH CODE FROM THE 
NR 6,9 NAME OF THE ROUTINE TO BE LOADED OR CALLED 
NR 7,9 

MR 6,6 THE HASH ADDRESS IS USED TO FIND THE ENTRY IN THE 
NR 7,9 INSURE NO MINUS SIGNS 

AR 6,7 MAIN AOCCN TABLE ENTPT IS USED TO RETURN TO 

SRDA 6,32(0) DIFFERENT SECTIONS CORRESPONDING TO THE 

0 6.HSHDIV ENTRY POINT CALLED 

LR 7,6 PUT REMAINDER IN REG 7 

SR 8,8 INDICATE MAIN ADCON TABLE LAST USED 

ST 8 »HSH IN3 

LR 9,7 7 CONTAINS THE BASIC HASH INOEX NOW 

M 8 , S IXF NOW COMPUTE INOEX FOR AOCON TABLES 
ST 7,HSHIM SAVE HASH INDICES 

ST 9.HSHIN2 EACH ENTRY IN THE ADCON TABLES IS SIX LONG 
L 2, BASADT SET UP BASE REG FOR MAIN ADCON TABLE AOTABL 
USING AOTABL, 2 

L 0, ENTPT NOW RETURN TO APPROPRIATE SECTION OF CODING 
C 8, ONE CORRESPONDING TO ENTRY POINT CALLED 
BL RETLOC LOAD WAS ENTRY POINT 
BE RETLDD LOADED WAS ENTRY POINT 
6 RETCAL RUNIT WAS THE ENTRY POINT 
RETLOC LR 10,2 

AR IG ,9 SETUP BASE FOR AOCCN DSECT 
USING CHAADC, 10 

LM 6,7 , AECPNAM PICK UP NAME FIELD IN AOCON 

C 6, BLANKS CHECK IF THE ADCON HAS NOT BEEN ARMED OR USED 
BNE CHKNAM 
C 7, BLANKS 

BE LODE ADCON AVAILABLE FOR USE GO LOAD 
CHKNAM CR 4,6 CHECK ADCON NAME AGAINST ENTRY NAME FOR MATCH 



BNE CHEOVF RETURN IF MATCH IS FOUND OTHERWISE CHECK ADCON 
CR 5,7 OVERFLOW TABLE FOR HATCH 
BE RET3 HATCH FGUND UPDATE LASTCL AND RETURN 
CHEQVF L 6,2010,101 PICK UP OVFTAB POINTER 

L ll,BASCAC ESTABLISH BASE REG FOR OVERFLOW ADCON TABLE 
USING OVADTB ,1 l 

SR 7,7 IF OVERFLOW TABLE POINTER IS ZERO, THERE ISNT ANY 
CR 6,7 OVERFLOW CHAIN YET. THIS WILL BE FIRST ENTRY FOR 
BE L0DE1 OVERFLOW ADCON CHAIN 

SRCVTE LR 10,11 SUBROUTINE TO SEARCH OVERFLOW ADCON TABLE FOR MATCH 
AR 10,6 RECALCULATE BASE FOR ADCON GROUP 
ST 6,HSHIN2 SAVE INDEX POINTER 

ST 10, HSHIN3 INDICATE OVERFLOW ADCON TABLE LAST USED 
LH 6,7 , ACCPNAM CHECK NAME OF ADCON FOR MATCH WITH INPUT 
CP 4,6 
BNE LPl 
CR 5,7 

BE RETS MATCH FOUND RETURN 
LPI L 6,20(0,10) PICK UP NEXT ADCON ON CHAIN 

SR 7,7 IF THE CHAIN POINTER IS ZERO, WE HAVE SEARCHED THRU 
CR 6,7 THE OVERFLOW ADCON CHAIN 

0NE SR0VT6 NOT AT END OF CHAIN CONTINUE SEARCH 
L 8.ENTPT MATCH NCT FOUND IN CHAIN RETURN 
C 8, ONE ENT PT IS USED TO FIGURE POINT OF RETURN 
8L LCDE1 ENTRY POINT WAS LOAD 
BE SRRET1 ENTRY POINT WAS LOADED 
fi SRRET2 ENTRY POINT WAS RUNIT 

L0CE1 l 6,0VF0PN PICK UP POINTER FOR NEXT AVAILABLE ADCON 
ST 6,20(C,10) SET ADCON POINTER TO UPDATE CHAIN 
ST 6.HSHIN2 

LR 10,11 SWITCH TO OVERFLOW ACCGN TABLE 
AR 10,6 UPDATE ADCON POINTER 

ST 10,HSHIN3 INDICATE OVERFLOW ADCON TABLE LAST USED 
LR 7,10 
A 6.SIXF 
ST 6 tCVFCPN 

C 6, TABFUL CHECK TO INSURE WE HAVENT EXHAUSTED OVERFLOW 
BH CATAST ADCON TABLE GO TO CATAST IF WE HAVE 
LCCE2 L 5, AGREND SETUP BASE TO GET SVC FOR ARM MACRO 
USING ENDPST ,9 
ARM (7J,RTCHAR 
DROP 5 

LR 10,7 THE ADCON IS ARMED 

MV I ACCC1L,X *00* SET ADCON FOR LOAD AND ERRCD=CODE OPTS 

MVI ACCC2L,X*01* 

LR 8,1 SAVE REG I 

LR 1,10 SET R 1 TO ADCON LOCATION 

LOAD EPLCC=(1I 

LR 1,8 THE REQUESTED FUNC IS LOADED RESTORE REG l 
TM ADCC2L, X* 06* CHECK FOR ERROR IN LOADING 
BNE ERROR OOPS WE BRAGGED TO SCON ROUTINE NOT LOADED 
B RET4 

RET3 L 8.ENTPT 

C 8, TWO 
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8E CALI DCN7 RETURN YET IF ENTRY HAS RUNIT 
RETA ST A, LASTCL UPDATE THE NAHE AND ADCDN INDEX FOR LAST 

ST 5.LASTCI CALLED CR LOADED ROUTINE 
L 8 »H$HIN2 
ST 8,LADPT 
L 8 , HSHI N3 
ST 8 , LADFT 1 

RET1 L 8. ONE SET ERRCCD TO INDICATE ALL IS OKAY 

ST 8,0(0,31 

RETS L 14,4(0,13) PICK UP CALLERS PSECT AND RETURN 

LR 13,14 RESTORE REG 13 TO CALLERS PSECT 
SR 15,15 SET RETURN CODE FOR FORTRAN 
RETURN ( 14,12) ,RC*15 

ACJNAM L 7, EIGHT TAKE THE 8 CHARACTER INPUT NAME WHICH IS RIGHT 
L 11, BLANK ADJUSTEC AND MAKE IT LEFT ADJUSTED 
SRL 11 ,2A ( 0 ) THIS IS AN INTERNAL SUBROUTINE LIKE HASH 

L 10, BLANK AND SRCVTB IT ALSO USES ENTPT TO RETURN 
L 8 tCHRMSK 

NCCNE LR 5, A BASIC LOCP TO CHECK FOR BLANKS AND SHIFT 

NR 9,8 INPUT NAME IS IN REG A AND 5 OUTPUT NAME WILL 
C LR 9,10 WIND UP IN REG A AND 5 

BNE DONE GO TO CONE IF NON BLANK CHARACTER IS FOUND 

SLDL A, 8(0) 

OR 5,11 ADD A BLANK TO THE RIGHT END 

BCT 7 , NDONE CHECK TO INSURE AGAINST AN INDEFINITE LOOP 
B RET2 NAME WAS ALL BLANKS RETURN ERROR CODE 
DONE L 8, ENTPT 

C 8.CNE CHECK FOR WHICH RETURN TO TAKE 
BL CHRLOO 
BE CHRLDD 
8 CHRRUN 

RET2 L 8, TWO SET ERCCD INDICATER FOR TROUBLE AND RETURN 

ST 8,010,3) 

B RETS 

LCCE LR 7,10 

B LODE 2 

USING LOADED, 15 
LOADED SAVE (1A,12) 

L 1A,72(C,13J LOAD R 1 A WITH OUR PSECT 
ST 14,810,13) BACKWARD PSECT POINTER 
ST 13,4(0,14) FORWARD PSECT POINTER 
LR 13,14 
USING GNCL ffP, 13 

L 12,8ASACR SWITCH TO R12 FOR OUR CSECT BASE REG 
DROP 15 
USING LOAD, 12 

L 10, ONE SET ENTPT TO INDICATE LOADED WAS ENTRY POINT 
ST 1 0 » EN T PT LOADED CHECKS ADCON TABLES TO FIND IF A FUNC 
L 2, 0(0,1) HAS BEEN PREVIOUSLY LOADED PICK UP PARAM LIST 
ST 2 , BCD NAM SAVE ADDRESS OF FIRST ARG 
L 3,4(0, 1) 

ST 3, ERRCCD SAVE ADDRESS OF SECOND ARGUMENT 
LM 4,5,0(21 PICK UP FUNCTION NAME 
B ADJNAM MAKE RIGHT ADJUSTED NAME LEFT ADJUSTED 
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CHRLDO STM 4*5 ,RTCHAR SAVE LEFT AC JUSTED NAME 
C 4* LA5TCL USED 
BNE CCNCK1 
C 5, LASTC 1 

BE RET1 HATCH FOUND RETURN 

CCNCK1 B HASH NATCH NCT FOUND HASH NAME PEG 9 HAS AOCON INDEX 

RETLDD LR 10*2 SET REG 2 AND 10 AS BASE FOR MAIN ADCON TABLE 

AR 1C. 9 SET UP EASE FOR ADCCN DSECT 
USING CHA ACC* 10 

LN 6*7* ADCPNAH CHECK FOR HATCH CF ADCCN NAME WITH INPUT 
CR 4,6 
BKE CCNCK2 
CR 5,7 
BE RET4 

CCNCK2 L 6,2010,10) MATCH NOT FOUND SEARCH ACCON CHAIN 
SR 7,7 

CR 6,7 IF POINTER TO OVERFLEW TABLE IS ZERO, THERE IS NO CHAIN 
BE RET2 END OF CHAIN, ROUTINE NOT FOUND OR LOADED 
L 11, BASCAC SET UP BASE REG FOR OVERFLOW ADCON TABLE 
USING 0VACT8* 1 1 

B SRCVTB SEARCH OVERFLOW ADCON TABLE FOR HATCH 
SRPET1 B RET2 MATCH NOT FOUND ROUTINE NOT LOADED 
USING RUN I T , 15 
RLiNIT SAVE (14,12) 

L 14,72 (C, 13) LOAD REG 14 WITH OUR PSECT 
ST 14,8(C,13> STORE BACKWARD POINTER 
ST 13,4(0*14) STORE FORWARD POINTER 

LR 13,14 LOAD REG 13 WITH OUR PSECT AND ESTABLISH BASE REG 
USING GNCL#P » 13 

L 12, BAS ADR SWITCH TO R12 FOR OUR CSECT BASE REG . 

OPtP 15 
USING LOAD ,12 

L 10, TWO SET ENTPT TO INDICATE RUNIT WAS ENTRY POINT 
ST 10, ENTPT 

L 2,010,1) PICK UP ARGUMENTS 
ST 2.ECDNAM SAVE ADDRESS OF FIRST ARGUMENT 
L 3*16(0,1) PICK UP FIFTH ARG ACORESS 
ST 3 *ERRCCD SAVE ADDRESS OF FIFTH ARG 
L 6,12(0,1) 

ST 6 , A N S SAVE ADDRESS CF FOURTH ARG 
L 4,810,1) 

L 5, 4(0,1) 

ST 4 , AR AP AR SAVE ADCRESSES OF SECOND AND THIRD ARGS 
$T 5 *NPARM BUILD A CALLING PARAM LIST BASED ON THE ADDRESS 
SR 6,6 CE THE ARGUMENT ARRAY WHICH IS THE SECOND ARG 
SR 10,10 INITIALIZE FCR LCCP 
L 7 , FCURF INCREMENT FOR FULL WORD 
L 8, ONE INCREMENT TO COUNT ARGUMENTS 

L 9, 0(0,5) LOAD 9 WITH THE TOTAL NUMBER OF ARGS 
C 9.MAXARG CHECK TO SEE THERE ARE NOT MORE THAN ARE 

BH RET2 PROVIDED FOR 

PARIOP AR 6,e LOOP TO BUILD PARAM LIST 
ST 4*PARl$T(10l 

AR 10,7 ADD FULL WORD 1NCR ONTO PARLST INDEX 
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CHRRUN 


CCNCK3 

RETCAL 


CCNCK4 


SR RET 2 
CAL 


OV ABAS 
CALI 

CALOK 

TPYLCD 


AR 4.7 ADD FULL WORD I NCR ONTO ADDRESS OF ARAARG 
CR 6,9 CHECK FOR COMPLETED PARAMETER ADDRESS LIST 
BL PARLOR NOT COMPLETED 

LM 4 .5 ,0 (2 ) COMPLETE, PICKUP NAME OF FUNC TO BE CALLED 
B ADJNAM MAKE RIGHT ADJUSTED NAME LEFT ADJUSTED 
STM 4.5.RTCHAR SAVE LEFT ADJUSTED NAME 

C 4.LASTCL CHECK INPUT NAME AGAINST NAME OF FUNC LAST CALLED 
BNE CCNCK3 
C 5, LASTC 1 

BE CAL GO TO CALL THE FUNC 

B HASH HASH THE NAME AND GET PTS TO MAIN ADCON TABLE ENTRY 
LR 10,2 SET UP BASE FOR ADCON DSECT 
AR 10,9 

USING CHA A DC , 10 

LM 6,7,ACCPNAM CHECK TO SEE IF ADCON NAME MATCHES INPUT 
CR 4,6 
BNE CCNCK4 
CR 5,7 

BE CALI YES, MATCH FOUND 

L 6,2010,10) NO, PICK UP OVERFLOW ADCON TABLE POINTER 
SR 7,7 
CR 6,7 

BE RE72 END OF ADCON CHAIN AND NO MATCH ERRCOD =2 
L 11, BASE AC SETUP BASE FOR OVERFLOW ADCON TABLE 
USING OVADTB, 1 l 

B SROVTP SEARCH OVERFLOW ADCON TABLE FOR MATCH 
B RET2 MATCH NOT FOUNO SET ERRCOD = 2 
L 10 , L ADPT 
ST 10.HSHIN2 
SR 6,6 

6.LADPT1 CHECK TO SEE WHICH ACCCN TABLE TO USE 
BNE OVABAS 

A 10.PASAET CALCULATE ADDRESS OF ADCON 
B CALI GO CALL FUNC 

A 10 , fi ASCAC CALCULATE ADDRESS OF ADCON 

LR 8,1 SAVE REG 1 IN REGS 

LA 1, PARIS! SETUP ADORES OF PARAN LIST IN REG 1 
LR 15,10 SET REG 15 TO LOC OF ACCCN FOR CALL 
USING CHA ADC ,10 

MV I ADCC 1C » X * 0 1 ■ SET ADCCN FOR CALL AND £RRCD=CCDE OPTS 
MV I ACCC2C , X * 0 1 ' 

CALL 115), ,,E 

LR 1,8 CALL COMPLETE RESTORE REG 1 

TM A DCC2C , X ' 06 * CHECK FOR ERROR IN CALL 

BNE TRYLCD 

L 6 , AN S SAVE POSSIBLE FUNCTION RESULTS 

STE C,01C,6) 

B RET4 RETURN 

LR 7,10 

L 9 , ACRE ND SETUP BASE TO PICKUP SVC FOR ARM 

USING ENCPST ,9 

ARM 17),RTCHAR 

DROP 9 

LR 8,1 



C/TAST 


CL EAR I 


CLEARS 


ERROR 


* 

PSECT 

SAVE 

SAVES 

MASK 


LA 1,PARLST PICK UP ADDRESS OF PARAK LIST FOR CALL 
Lfi 15,10 POINT TO ADCCN FOR CALL NOW FULLY ARMED 
USING CHA ACC , 10 

MVI ADCC1C »X *01* SET AOCON FOR CALL ANO ERRCD^CODE OPTS 
MVI ADCC2C , X * 0 1 * 

CALL US}* »,£ 

LR 1,6 RESTORE REG 1 

TM A0CC2C,X*06* CHECK FOR ERROR IN CALL 

8NE ERROR NOTHING MORE WE CAN DO PMD DCESNT EXIST 

B CALOK 

L 10 ,BASC AC PT TO OVERFLOW ADCON TABLE SET UP TO CLEAR 
L 6 »FGURF SET UP FULL WORD INCREMENT 
SR 7,7 CLEAR INDEX 

SR fli fi 

ST 8,017,10) CLEAR OVERFLOW ADCON TABLE 
AR 7,6 INCREMENT INDEX BY A FULL WORD 
C 7, TABFUL SEE IF TABLE Alt CLEARED 
BL CLEAR I NOT CLEARED YET 

ST 8,0VFCPN CLEAR AVAILABLE OVERFLOW ENTRY POINTER 
L 1C, PTOVF SET BASE TO CLEAR OVERFLOW TABLE PTS IN MAIN 
SR 7,7 AOCON TABLE 

L 11, ONE INCREMENT TO COUNT ADCCN PTS CLEARED 
SR 9,9 

L 6 , SI XF INCREMENT BETWEEN PTS TO OVERFLOW ADCON TABLE 
ST 8,017,10 CLEAR PT TO OVERFLOW ADCON TABLE 
AR 7,6 
AR 9,11 

C 9.HSHDIV ARE WE ALL DONE CLEARING 
BL CLEAR2 NO WE ARE NOT DONE YET 
8 HASH 

SR 8,8 SET ERRCOD = 2 AND RETURN 
ST 8,0(0,10) CLEAR ACCONS 

$T 8,4(0,10 
ST 8 ,8 ( C, 10 ) 

ST 8, 12 (C, 10) 

ST 8,16(C,10) 

ST 8,20(0,10 

B RE72 

END 


ISRL, ISLL, eta 

TITLE * THE SHIFT FUNCTIONS FOR TIME SHARING * 


PSECT 
DS F 
DS F 

OC X'FFFFFFFF* 

ENTRY SRA,ISRA,ARS» IARS 
ENTRY 5LA,ISLA,ALS,IALS 
ENTRY SRL , I SRL 
ENTRY SL L , ISLL 
ENTRY SRDA,ISRDA,LR$,ALRS 
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ENTRY SLCA»ISLDA*LLS f ALLS 
ENTRY SRDL. I SRDL ,LGR .ALGR 
ENTRY SLOL*ISLDLiLGL|ALGL 

ENTRY AND, LAND* OR t LOR , EXOR. LEXOR , LCOMP.C OMPL 
ENTRY HSPA, IHSRA,HSLA, IHSLA 


SHIFTY 

CSECT 

READONLY * PU6L I C 


ARS 

£Q u 

♦ 



I ARS 

ECU 

* 



I SR A 

ECU 

* 



SR A 

SAVE 

(4,8) 




USING 

PSECT, 8 




t 

8,7210, 13) 

LOAD REGISTER 0. 



LH 

4 , 5 , 0 m 

A HAS THE LOCATION OF THE 

SHIFT COUNT 

* 



5 HAS THE LOCATION OF THE 

DATA 


L 

7,014) 

7 IS LOADED WITH THE SHIFT 

COUNT. 


t 

0,C<5) 

0 IS LO A CEO WITH THE DATA 



SRA 

0 , C ( 7 ) 

SHIFT SHIFT SHIFT 

SHIFT 


ST 

OtSAVE 




LE 

O f SAVE 

PUT IN THE FLOATING POINT 

REGISTER. 


RETURN 

1 (4,8) 




SPACE 

6 



IALS 

EQU 

* 



At $ 

ECU 

* 



I SLA 

ECU 

* 



SLA 

SAVE 

(4,8) 




L 

8,72(0,13) 

LOAD REGISTER B. 



LH 

4,5,011) 

A HAS THE LOCATION OF THE 

SHIFT COUNT 

♦ 



5 HAS THE LOCATION OF THE 

DATA 


L 

7,0(4) 

7 IS LOADED WITH THE SHIFT 

COUNT. 


t 

0,0(5) 

0 IS LOADED WITH THE DATA 



SLA 

0 , C ( 7 ) 

SHIFT SHIFT SHIFT 

SHIFT 


ST 

0, SAVE 




LE 

OtSAVE 

PUT IN THE FLOATING POINT 

REGISTER. 


RETURN 

i (4,8) 




EJECT 




ISRL 

ECU 

* 



SR L 

SAVE 

(4,8) 




L 

8,72(0,13) 

LOAD REGISTER 0. 



LW 

4, 5, cm 

A HAS THE LOCATION OF THE 

SHIFT COUNT 

* 



5 HAS THE LOCATION OF THE 

DATA 


L 

7 , C ( 4 ) 

7 IS LOADED WITH THE SHIFT 

COUNT 


t 

0 , € ( 5 ) 

0 IS LOADED WITH THE DATA 



SRt 

0 , C ( 7 } 

SHIFT SHIFT SHIFT 

SHIFT 


ST 

0, SAVE 




LE 

€ , SAVE 

PUT IN THE FLOATING POINT 

REGISTER. 


RETURN 

1 14,8) 




SPACE 

6 



I SLL 

EQU 

* 



SLl 

SAVE 

(4,8) 




t 

8,72(0,13) 

LOAD REGISTER 8. 



LK 

4,5,01 1) 

A HAS THE LOCATION OF THE 

SHIFT COUNT 

* 



5 HAS THE LOCATION OF THE 

DATA 


t 

7,0(4) 

7 IS LO A DEO WITH THE SHIFT 

COUNT 


L 

0 , C ( 5 J 

0 IS LOADED WITH THE DATA 




SLL 

C » C { 7 ) 

SHIFT SHIFT 

SHIFT 

SHIFT 


SI 

0* SAVE 





LE 

0 » SAVE 

PUT IN the floating point 

REGISTER* 


RETURN 14*8) 





EJECT 





ALPS 

ecu 

* 




L«S 

ECU 

* 




ISPDA 

ECU 

* 




SPCA 

SAVE 

14,8) 





L 

8,72(0.13) 

LOAD REGISTER 8. 




LM 

4, 5, C(l> 

4 HAS THE LOCATION 

OF THE 

SHIFT COUNT 

* 



5 HAS THE LOCATION 

OF THE 

DATA 


L 

7 , C ( 4 ) 

7 IS LOACED WITH THE SHIFT COUNT. 


L 

0 , C ( 5 ) 

C IS LOAEEO WITH THE DATA 



L 

I * S AVE2 





SROA 

0 ,C ( 7 ) 

SHIFT SHIFT 

SHIFT 

SHIFT 


SI 

0 , SAVE 





$1 

1.SAVE2 





LE 

0 , SAVE 

PUT IN THE FLOATING POINT 

REGISTER. 


RETURN 14,8) 





SPACE 

6 




ALLS 

ECU 

* 




LLS 

ECU 

* 




ISLOA 

EQU 

* 




SICA 

SAVE 

(4,8) 





L 

8,72(0,13) 

LOAD REGISTER 8. 




LN 

4, 5, 0(1) 

4 HAS THE LOCATION 

OF THE 

SHIFT COUNT 

* 



5 HAS THE LOCATION 

OF THE 

DATA 


L 

7 , C (4 ) 

7 IS LOACED WITH THE SHIFT COUNT 


L 

€ , C ( 5 ) 

0 IS LOADED KITH THE DATA 



L 

1, SAVE2 





SLOA 

0,C (7) 

SHIFT SHIFT 

SHIFT 

SHIFT 


SI 

0 , SAVE 





ST 

1, S AVE2 





LE 

0, SAVE 

PUT IN THE FLOATING 

; POINT 

REGISTER* 


RETURN (4,8) 





EJECT 





AL CP 

ECU 

* 




LGP 

ECU 

* 




ISPDL 

ECU 

* 




SR CL 

SAVE 

(4,81 





L 

8,72(0, 13) 

LOAD REGISTER 8. 





4, 5 , 0(1) 

4 HAS THE LOCATION 

OF THE 

SHIFT COUNT 

* 



5 HAS THE LOCATION 

OF THE 

DATA 


L 

7,0(4) 

7 IS LOADED WITH THE SHIFT 

COUNT 


L 

0 , € { 5 ) 

0 IS LOACED WITH THE DATA 



L 

1 * SAVE? 





5RDL 

0,C (7) 

SHIFT SHIFT 

SHIFT 

SHIFT 


ST 

0,SAVE 





$! 

I , 5 A VE2 





LE 

OrSAVE 

PUT IN THE FLOATING 

POINT 

REGISTER* 


RETURN 

(4,8) 





SPACE 

6 




ALCL 

ECU 

* 
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LGl 

ECU 

* 


ISLCL 

ECU 

* 


St CL 

SAVE 

u,e) 



L 

8,72(0, L3) 

LOAD REGISTER 8. 


in 

4,5, cm 

4 HAS THE LOCATION OF THE SHIFT COUNT 

* 



5 HAS THE LOCATION OF THE DATA 


L 

7 , 0 (4 > 

7 IS LOADED WITH THE SHIFT COUNT 


L 

C, C 15 ) 

0 IS LOADED WITH THE DATA 


t 

1.SAVE2 



SLOL 

0,Ct7) 

SHIFT SHIFT SHIFT SHIFT 


ST 

O, SA VE 



ST 

1.SAVE2 



LE 

0, SAVE 

PUT IN THE FLOATING POINT REGISTER. 


RETURh 

! (4 ,e) 



TITLE 

• AND, 

OR, EXCLUSIVE OR AND COMPLEMENT • 

and 

ECU 

* 


LA M3 

S/Vi 

(4,8) 



L 

8,7210, 13) 

LOAD REG 8 WITH PSECT LOCATION 


in 

4,5,0( 1) 



L 

0,C 14) 

LOAD FIRST ARG INTO REG 0. 


H 

0,0(5) 

AND WITH 2ND ARG 


ST 

C.SAVE 



LE 

OtSAVE 

PUT IN FLOATING PT. REGISTERS 


RETURIV 

! (4,8) 



5PACE 

6 


OR 

ECU 

* 


LCR 

S/VE 

(4,8) 



L 

8,72(0,13) 

LOAD REG 8 WITH PSECT LOCATION 


in 

4, 5, 0(1) 



L 

C,C (4 ) 

LOAD FIRST ARG INTO REG 0. 


□ 

0, C ( 5 > 

OR WITH 2ND ARG 


ST 

0 , SAVE 



LE 

C , SAVE 

PUT IN FLOATING PT. REGISTERS 


KiTUBJS 

i (4,8) 



EJECT 



excr 

ECU 

* 


LFXOR 

S/VE 

(4,8) 



L 

8,72(0,13) 

LOAD REG 8 WITH PSECT LOCATION 


LH 

4,5,011) 



L 

0 , C ( 4 ) 

LOAD FIRST ARG INTO REG 0. 


X 

0,0(5) 

EXCLUSIVE OR WITH 2ND ARG 


ST 

0 , S A VE 



Li 

0 , SA VE 

PUT IN FLOATING PT. REGISTERS 


RE TURIN 

(4,8) 



SPACE 

6 


CCPPL 

ECU 

* 


LCCPP 

S/VE 

(4,8) 



L 

8,72(0,13) 

LCAO REG 8 WITH PSECT LOCATION 


LM 

4»5»0( l) 



L 

0,0(4) 

LOAD FIRST ARG INTO REG 0. 


X 

O.MASK 

COMPLEMENT ALL BITS 


ST 

OtSAVE 



le 

0 , SA VE 

PUT IN FLOATING PT. REGISTERS 


RETURN 

i (4,8) 
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H SR A 
IHSRA 


ECU * 

SAVE 14*7) 

I> 4,5, 0U> 

L 7*C 1 4 ) SHIFT COUNT 

LH 0*0(5) CATA 

SRA 0,0(7) 

ST 0*52(0,13) R8 SAVE AREA 

ST 1*56(0,13) R9 SAVE AREA 

LE 0,52(0,13) 

01 RETURN (4,7) 

HSLA ECU * 

IH5LA SAVE (4,7) 

LK 4,5,011) 

L 7,0(4) SHIFT COUNT 

LH 0,0(5) CATA 

SLA C , C ( 7 ) SHIFT SHIFT SHIFT SHIFT 

ST 0,52(0,13) R8 SAVE AREA 

ST 1,56(0,13) R9 SAVE AREA 

LE 0,52(0,13) 

02 RETURN (4,7) 

END 
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